Internet Tools (InfoMagic)

home *** CD-ROM | disk | FTP | other *** search

/ Internet Tools (InfoMagic) / Internet Tools.iso / applic / ncsa / tn3270 / wmac.assemble.Z / wmac.assemble

Wrap

Text File | 1989-11-18 | 201KB | 2,481 lines

WMAC TITLE 'Program to Transfer a CMS File to a Macintosh' 00000001 WMAC CSECT 00000002 EXTRN CRCTAB,SCRIO 00000003 PRINT NOGEN 00000004 REGEQU 00000005 USING *,R15 00000006 STM R0,R15,REGSAVE SAVE ALL REGISTERS 00000007 LR R10,R15 00000008 LA R11,2048(R10) 00000009 LA R11,2048(R11) 00000010 LA R12,2048(R11) 00000011 LA R12,2048(R12) 00000012 DROP R15 00000013 USING WMAC,R10,R11,R12 R10 - R12 = WCPM BASE REGISTERS 00000014 USING NUCON,0 ALSO ADDRESS NUCON 00000015 SR R15,R15 00000016 ST R15,RTNCODE RETURN CODE INITIALIZED TO ZERO 00000017 ST R15,RETRYCNT TOTAL RETRY COUNT = 0 00000018 ST R15,BUFSIZE OUTPUT BUFFER EMPTY 00000019 ST R15,TOTCHRS INITIALIZE TIMING DATA 00000020 ST R15,TOTSECS 00000021 ST R15,TOTSECS+4 00000022 MVI FLAGS,0 ALL FLAGS = 0 00000023 MVI FLAGS2,0 00000024 MVI FLAGS3,0 00000025 MVI TRMFLAGS,0 ALSO TERMINAL FLAGS 00000026 MVC PCKSIZE(4),=F'1024' DEFAULT IS 1K PACKETS 00000027 BAL R14,GETID DEFINE LOCAL NODEID 00000028 CLC NODEID(8),BROWNID CHECK FOR BROWN 00000029 BNE NOTBROWN IF BROWN, SET FLAG BIT 00000030 OI FLAGS3,ALTTR FOR ALT. XLATE TABLES 00000031 NOTBROWN MVC VERSDATA(5),=C' 0000' INITIALIZE VERSION DATA 00000032 MVC XFSPEED(4),=C'0000' INITIALIZE TRANSFER RATE 00000033 LA R9,INFILE R9 -> INPUT FILE FSCB 00000034 USING FSCBD,R9 00000035 MVC FSCBFM(2),=CL2'*' DEFAULT FM IS "*" 00000036 MVC DSKMODE(1),=CL2'*' 00000037 CLI 8(R1),X'FF' ERROR IF FN OR FT MISSING 00000038 BE BADID 00000039 CLI 16(R1),X'FF' 00000040 BE BADID 00000041 MVC FSCBFN(16),8(R1) SAVE VALID FN AND FT 00000042 CLI FSCBFT,C'.' FT BEGINS WITH A PERIOD? 00000043 BNE KEEPFT NO, KEEP FT AS IS 00000044 MVC FSCBFT(7),FSCBFT+1 SHIFT CHARACTERS OVER 00000045 MVI FSCBFT+7,C' ' PUT BLANK AT END 00000046 MVI DELIM,C'.' USE "." FOR MAC DELIMITER 00000047 KEEPFT EQU * 00000048 CLC 24(8,R1),=C'(' OPTIONS MAY START HERE ALSO 00000049 BE HAVEID 00000050 CLI 24(R1),X'FF' SAVE FILEMODE IF GIVEN 00000051 BE DOSTATE 00000052 MVC FSCBFM(2),24(R1) SAVE CALLER'S FM 00000053 MVC DSKMODE(1),24(R1) 00000054 B HAVEID 00000055 EJECT 00000056 * SAVE AREA LOCATED HERE FOR ADDRESSABILITY 00000057 REGSAVE DS 8D REGISTER SAVE AREA 00000058 RTNCODE EQU REGSAVE+60 RETURN CODE AT LOCATION FOR R15 00000059 SPACE 00000060 BADID EQU * FILE ID ERROR 00000061 LINEDIT TEXT='DMSWMC054E Incomplete fileid specified', X00000062 DISP=ERRMSG 00000063 MVI RTNCODE+3,24 00000064 B CMSRTN 00000065 SPACE 00000066 HAVEID EQU * FSCB FILEID COMPLETE 00000067 LA R2,32(R1) R2 = OPTION POINTER 00000068 OPTLOOP EQU * PROCESS OPTIONS 00000069 CLC 0(8,R2),=8X'FF' END AT X'FF' 00000070 BE OPTCHECK 00000071 CLC 0(8,R2),=CL8')' ALSO ")" 00000072 BE OPTCHECK 00000073 CLC 0(8,R2),=CL8'(' SKIP "(" 00000074 BE NEXTOPT 00000075 LA R5,8 GET LENGTH IN R5 00000076 LA R4,7(R2) R4 -> LAST BYTE 00000077 LENLOOP EQU * LOOP TO GET LENGTH 00000078 CLI 0(R4),C' ' AT NON-BLANK? 00000079 BNE HAVELEN YES, LENGTH IN R5 00000080 BCTR R4,0 R4 -> PREVIOUS BYTE 00000081 BCT R5,LENLOOP DECREMENT & REPEAT 00000082 B OPTERR ALL BLANK IS ERROR 00000083 SPACE 00000084 HAVELEN BCTR R5,0 DECREMENT LENGTH FOR EX 00000085 LA R4,OPTTAB R4 -> OPTION TABLE 00000086 TABCHECK EQU * LOOK FOR MATCH IN TABLE 00000087 CLI 0(R4),X'FF' AT TABLE END? 00000088 BE OPTERR YES, BAD OPTION 00000089 EX R5,TABCLC FOUND A MATCH? 00000090 BE USEOPT YES, HANDLE OPTION 00000091 LA R4,12(R4) R4 -> NEXT OPTION 00000092 B TABCHECK TRY AGAIN 00000093 SPACE 00000094 USEOPT L R3,8(R4) GET ADDRESS OF ROUTINE 00000095 BR R3 EXECUTE CODE FOR OPTION 00000096 SPACE 00000097 NEXTOPT EQU * OPTION CODE RETURN HERE 00000098 LA R2,8(R2) CHECK OUT NEXT TOKEN 00000099 B OPTLOOP 00000100 SPACE 00000101 TABCLC CLC 0(*-*,R4),0(R2) COMPARE TABLE ENTRY TO OPTION 00000102 SPACE 00000103 MENUOPT NI FLAGS,255-NOMENU RESET FLAG 00000104 B NEXTOPT 00000105 SPACE 00000106 NOMENOPT OI FLAGS,NOMENU SET FLAG 00000107 B NEXTOPT 00000108 SPACE 00000109 ASCOPT OI FLAGS2,ASCXF SET FLAG 00000110 B NEXTOPT 00000111 SPACE 00000112 BINOPT OI FLAGS2,BINXF SET FLAG 00000113 B NEXTOPT 00000114 SPACE 00000115 NOASCOPT NI FLAGS2,255-ASCXF RESET FLAG 00000116 B NEXTOPT 00000117 SPACE 00000118 NOBINOPT NI FLAGS2,255-(BINXF+MACBIN) RESET FLAGS 00000119 B NEXTOPT 00000120 SPACE 00000121 TRUNCOPT OI FLAGS,TRUNCATE+TEXT SET FLAGS 00000122 B NEXTOPT 00000123 SPACE 00000124 TEXTOPT OI FLAGS,TEXT SET FLAG 00000125 B NEXTOPT 00000126 SPACE 00000127 MACOPT OI FLAGS2,MACBIN+BINXF SET FLAGS 00000128 B NEXTOPT 00000129 SPACE 00000130 NOMACOPT NI FLAGS2,255-MACBIN RESET FLAG 00000131 B NEXTOPT 00000132 SPACE 00000133 PRTOPT OI FLAGS2,PRTXF SET FLAG 00000134 B NEXTOPT 00000135 SPACE 00000136 NOPRTOPT NI FLAGS2,255-PRTXF RESET FLAG 00000137 B NEXTOPT 00000138 SPACE 00000139 STDXOPT NI FLAGS3,255-ALTTR RESET ALT. XLATE FLAG 00000140 B NEXTOPT 00000141 SPACE 00000142 OPTERR LINEDIT TEXT='DMSWMC003E Invalid option ''........''', X00000143 SUB=(CHARA,(R2)),DISP=ERRMSG 00000144 MVI RTNCODE+3,24 00000145 B CMSRTN 00000146 SPACE 00000147 OPTCHECK EQU * CHECK FOR OPTION ERRORS 00000148 TM FLAGS2,BINXF+ASCXF BINARY AND ASCII BOTH SPECIFIED? 00000149 BNO DOSTATE NO, CONTINUE 00000150 LINEDIT TEXT='DMSWMC066E ''ASCII'' and ''BINARY'' or ''MACBIN'X00000151 ' are conflicting options',DISP=ERRMSG 00000152 MVI RTNCODE+3,24 00000153 B CMSRTN 00000154 SPACE 00000155 DOSTATE EQU * 00000156 FSSTATE FSCB=INFILE,ERROR=STATERR,FORM=E 00000157 B FILEOK 00000158 SPACE 00000159 STATERR EQU * HANDLE ERRORS FROM STATE 00000160 ST R15,RTNCODE SAVE RETURN CODE 00000161 C R15,=F'36' ERROR 36 IS DISK NOT ACCESSED 00000162 BE NODISK 00000163 C R15,=F'28' ELSE IF NOT 28, ASSUME STATE 00000164 BNE CMSRTN TYPED MESSAGE 00000165 LINEDIT TEXT='DMSWMC002E File ''....................'' not fouX00000166 nd',DISP=ERRMSG,SUB=(CHAR8A,FSCBFN) 00000167 MVI RTNCODE+3,28 00000168 B CMSRTN 00000169 SPACE 00000170 NODISK LINEDIT TEXT='DMSWMC069E Disk ''..'' not accessed', X00000171 SUB=(CHARA,DSKMODE),DISP=ERRMSG 00000172 B CMSRTN 00000173 SPACE 00000174 FILEOK EQU * 00000175 * FILL-IN FSCB FROM FST 00000176 MVC FSTCOPY(64),0(R1) MAKE COPY OF FST 00000177 LA R1,FSTCOPY R1 -> FST COPY 00000178 USING FSTD,R1 ADDRESS FST FOR FILE 00000179 MVC FSCBFV(1),FSTRECFM COPY RECFM FROM FSCB 00000180 L R2,FSTLRECL R2 = RECORD LENGTH 00000181 DROP R1 DONE WITH FST COPY 00000182 LA R2,9(R2) ADD 7 + 2 FOR CR, LF 00000183 SRL R2,3 R2 = DOUBLEWORDS NEEDED 00000184 LR R0,R2 COPY INTO R0 00000185 DMSFREE DWORDS=(0),TYPE=USER,ERR=STGERR,MSG=NO 00000186 STM R0,R1,INPBUFDW STORE SIZE, ADDRESS 00000187 OI FLAGS2,IOBUFF REMEMBER FRET NEEDED 00000188 B TRMINIT CONTINUE 00000189 SPACE 00000190 STGERR LINEDIT TEXT='DMSWMC109S Virtual storage capacity exceeded', X00000191 DISP=ERRMSG 00000192 MVI RTNCODE+3,104 RC = 104 00000193 B CMSRTN 00000194 EJECT 00000195 * 00000196 * PERFORM ONE-TIME INITIALIZATION 00000197 * 00000198 TRMINIT BAL R14,TERMTYPE DETERMINE TERMINAL TYPE 00000199 OI FLAGS2,TERMINIT REMEMBER TERM INIT. DONE 00000200 TM TRMFLAGS,MAC3270 MAC3270? 00000201 BZ INITCONT NO, CONTINUE 00000202 MVC PCKSIZE(4),=F'2304' SET BIGGER PACKET SIZE 00000203 CLC M3270VER+1(4),=C'0110' NEW ENOUGH? 00000204 BNL INITCONT YES, CONTINUE 00000205 MVC M3270VER(2),M3270VER+1 FORMAT VERSION NUMBER 00000206 MVI M3270VER+2,C'.' 00000207 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00000208 LINEDIT TEXT='DMSWMC011E This version of Mac3270 (.....) does X00000209 not support file transfer', X00000210 SUB=(CHARA,M3270VER),DISP=ERRMSG 00000211 MVI RTNCODE+3,36 STORE RETURN CODE & RETURN 00000212 B CMSRTN 00000213 SPACE 00000214 INITCONT TM TRMFLAGS,GRAFTRM 3270 TERMINAL? 00000215 BO CPOK2 YES, SKIP ASCII INIT. 00000216 * DO ASCII INITIALIZATION 00000217 MVC INTAB(4),AINTRTBL SAVE "SET INPUT" TABLE 00000218 MVC OUTTAB(4),AOUTRTBL SAVE "SET OUTPUT" TABLE 00000219 DMSEXS XC,AINTRTBL(4),AINTRTBL RESET INPUT TRANSLATION 00000220 DMSEXS XC,AOUTRTBL(4),AOUTRTBL RESET OUTPUT TRANSLATION 00000221 LINEDIT TEXT='SET LINEDIT OFF',DOT=NO,DISP=CPCOMM 00000222 LTR R15,R15 CHECK FOR ERROR FROM CP 00000223 BZ CPOK1 00000224 ST R15,RTNCODE SAVE RETURN CODE 00000225 LINEDIT TEXT='DMSWMC010E Error from CP "SET" command', X00000226 DISP=ERRMSG 00000227 B CMSRTN 00000228 SPACE 00000229 CPOK1 EQU * SET PROMPT TO >, DC2 00000230 CLC NODEID(8),BROWNID SKIP PROMPT COMMAND IF NOT BROWN 00000231 BNE CPLSIZE 00000232 LINEDIT TEXTA=PRMTCMD,DOT=NO,DISP=CPCOMM 00000233 LTR R15,R15 CHECK FOR ERROR FROM CP 00000234 BNZ CPERR 00000235 CPLSIZE LINEDIT TEXT='TERM LINESIZE OFF',DOT=NO,DISP=CPCOMM 00000236 LTR R15,R15 CHECK FOR ERROR FROM CP 00000237 BZ CPOK2 00000238 CPERR ST R15,RTNCODE SAVE RETURN CODE 00000239 LINEDIT TEXT='DMSWMC010E Error from CP "TERM" command', X00000240 DISP=ERRMSG 00000241 B CMSRTN 00000242 SPACE 00000243 CPOK2 EQU * HAVE MAC ENTER XFER MODE 00000244 LA R1,CTLFS R1 -> STRING 00000245 LA R2,2 R2 = LENGTH 00000246 BAL R14,WRITE OUTPUT STRING 00000247 EJECT 00000248 * 00000249 * ATTEMPT TO GET VERSION INFORMATION. END FILE TRANSFER IF 00000250 * NOT A SUPPORTED SYSTEM. 00000251 * 00000252 MVI VERSDATA,C'M' SET MACINTOSH DEFAULT 00000253 MVC SENDDATA(2),=C'VR' "VR" FOR VERSION REQUEST 00000254 LA R1,2 COMMAND LENGTH IS 2 00000255 STH R1,SENDLEN 00000256 BAL R14,CPMCMMD EXECUTE COMMAND 00000257 L R1,=A(RECVDATA) R1 -> RESULT 00000258 CLC 0(2,R1),=C'VI' DID WE GET VERSION INFO.? 00000259 BNE CHKSYS NO, KEEP DEFAULT 00000260 MVC VERSDATA(5),2(R1) COPY VERSION DATA 00000261 CHKSYS CLI VERSDATA,C'M' IS IT A MACINTOSH SYSTEM? 00000262 BE SYSOK YES, CAN CONTINUE 00000263 CLI VERSDATA,C'C' IS IT A CP/M SYSTEM? 00000264 BE SYSOK YES, CAN CONTINUE 00000265 LA R1,2 COMMAND LENGTH IS 2 00000266 STH R1,SENDLEN 00000267 MVC SENDDATA(2),=C'EX' "EXIT" COMMAND 00000268 BAL R14,CPMCMMD EXECUTE COMMAND, IGNORE RESULTS 00000269 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00000270 LINEDIT TEXT='DMSWMC010E Remote system type is unknown', X00000271 DISP=ERRMSG 00000272 MVI RTNCODE+3,36 STORE RETURN CODE & RETURN 00000273 B CMSRTN 00000274 SPACE 00000275 SYSOK EQU * 00000276 CLC VERSDATA+1(4),=C'0000' IS XFSPEED SUPPORTED? 00000277 BE VERTESTS NO, KEEP FLAG OFF 00000278 OI FLAGS,XFS SET FLAG FOR XFSPEED 00000279 VERTESTS EQU * SPECIFIC VERSION TEST 00000280 CLI VERSDATA,C'M' MACINTOSH? 00000281 BNE VERSEND NO, NOTHING SPECIAL 00000282 TM TRMFLAGS,MAC3270 APPLETALK CONNECTION? 00000283 BO VERSATLK YES, SEPARATE TESTS 00000284 TM FLAGS2,PRTXF PRINTING REQUESTED? 00000285 BZ VTRMCONT NO, CONTINUE 00000286 CLC VERSDATA+1(4),=C'0441' IS TERM NEW ENOUGH? 00000287 BL VERSERR NO, RETURN ERROR 00000288 VTRMCONT CLC VERSDATA+1(4),=C'0430' IS TERM NEW ENOUGH? 00000289 BL VERSEND NO, KEEP FLAGS OFF 00000290 OI FLAGS2,ASCBIN+COMP SET FLAGS FOR ASCBIN, COMPRESSION 00000291 B VERSEND 00000292 SPACE 00000293 VERSATLK EQU * APPLETALK VERSION TEST 00000294 TM FLAGS2,PRTXF PRINTING REQUESTED? 00000295 BZ VATLCONT NO, CONTINUE 00000296 CLC VERSDATA+1(4),=C'0225' IS MAC3270 NEW ENOUGH? 00000297 BL VERSERR 00000298 VATLCONT CLC VERSDATA+1(4),=C'0140' MAC3270 NEW ENOUGH? 00000299 BL VERSEND NO, KEEP FLAGS OFF 00000300 OI FLAGS2,COMP SET COMPRESSION FLAG 00000301 VERSEND EQU * FINISH FILE INIT. /W VERSION INFO. 00000302 TM FLAGS2,MACBIN MACBINARY TRANSFER REQUESTED? 00000303 BZ BINCHK NO, CHECK JUST BINARY 00000304 TM FLAGS2,COMP COMPRESSION SUPPORTED? 00000305 BZ VERSERR NO, TOO OLD FOR MACBINARY 00000306 BINCHK TM FLAGS2,BINXF BINARY TRANSFER REQUESTED? 00000307 BZ GETFSIZE NO, CONTINUE WITH FILE SIZE 00000308 TM TRMFLAGS,MAC3270 APPLETALK CONNECTION? 00000309 BO GETFSIZE YES, BINARY ALWAYS OK 00000310 TM FLAGS2,ASCBIN ASCBIN SUPPORT? 00000311 BO GETFSIZE YES, BINARY IS OK 00000312 VERSERR LA R1,2 COMMAND LENGTH IS 2 00000313 STH R1,SENDLEN 00000314 MVC SENDDATA(2),=C'EX' "EXIT" COMMAND 00000315 BAL R14,CPMCMMD EXECUTE COMMAND, IGNORE RESULTS 00000316 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00000317 MVC M3270VER(2),VERSDATA+1 FORMAT VERSION NUMBER 00000318 MVI M3270VER+2,C'.' 00000319 MVC M3270VER+3(2),VERSDATA+3 00000320 LINEDIT TEXT='DMSWMC012E This version (.....) of Mac3270 or TeX00000321 rm does not support the requested transfer type', X00000322 SUB=(CHARA,M3270VER),DISP=ERRMSG 00000323 MVI RTNCODE+3,36 STORE RETURN CODE & RETURN 00000324 B CMSRTN 00000325 SPACE 00000326 GETFSIZE LA R1,FSTCOPY RESTORE R1 -> FST COPY 00000327 BAL R14,SIZECALC COMPUTE FILE SIZE 00000328 TM FLAGS2,MACBIN MACBINARY TRANSFER? 00000329 BZ GETDATE NO, CONTINUE WITH DATE 00000330 CLC TOTSIZE(4),=F'128' AT LEAST 128 BYTES? 00000331 BNL GETDATE YES, CAN CONTINUE 00000332 LA R1,2 COMMAND LENGTH IS 2 00000333 STH R1,SENDLEN 00000334 MVC SENDDATA(2),=C'EX' "EXIT" COMMAND 00000335 BAL R14,CPMCMMD EXECUTE COMMAND, IGNORE RESULTS 00000336 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00000337 LINEDIT TEXT='DMSWMC014E File ''....................'' is not X00000338 in MacBinary format', X00000339 SUB=(CHAR8A,FSCBFN),DISP=ERRMSG 00000340 MVI RTNCODE+3,32 STORE RETURN CODE & RETURN 00000341 B CMSRTN 00000342 SPACE 00000343 GETDATE CLI VERSDATA,C'C' CP/M SYSTEM? 00000344 BNE GETMDATE NO, GET MAC DATE 00000345 BAL R14,CPMDATE ELSE GET CP/M DATE 00000346 B HAVEDATE AND CONTINUE 00000347 SPACE 00000348 GETMDATE BAL R14,MACDATE COMPUTE MAC DATE & TIME 00000349 HAVEDATE MVC FSCBAITN(4),=F'0' ITEM NO. = 0 00000350 L R1,INPBUF FILL-IN BUFFER ADDRESS 00000351 ST R1,FSCBBUFF 00000352 LA R1,FSTCOPY FILL-IN BUFFER LENGTH 00000353 USING FSTD,R1 GET LRECL FROM FST COPY 00000354 L R1,FSTLRECL 00000355 DROP R1 00000356 ST R1,FSCBSIZE STORE AS BUFFER SIZE 00000357 MVC FSCBANIT(4),=F'1' NO. OF ITEMS TO READ = 1 00000358 * GENERATE CP/M FILE ID 00000359 MVC MACID(8),FSCBFN INITIALIZE MAC ID WITH 00000360 MVC MACID+8(9),=CL9' ' FILENAME 00000361 LA R1,MACID R1 -> FIRST BLANK IN ID 00000362 IDLOOP CLI 0(R1),C' ' LOOP UNTIL BLANK REACHED 00000363 BE MOVEFT 00000364 LA R1,1(R1) 00000365 B IDLOOP 00000366 SPACE 00000367 MOVEFT CLI VERSDATA,C'C' CP/M? 00000368 BE CPMMFT YES, DIFFERENT ID FORMAT 00000369 MVC 0(1,R1),DELIM APPEND DELIMITER 00000370 MVC 1(8,R1),FSCBFT AND FILETYPE 00000371 TM FLAGS2,PRTXF PRINTING FILE? 00000372 BO USEFT YES, KEEP CASE AS IS 00000373 L R2,=A(TOLOWER) TRANSLATE TO LOWER CASE 00000374 TR MACID(17),0(R2) 00000375 B USEFT 00000376 SPACE 00000377 CPMMFT MVI 0(R1),C'.' APPEND PERIOD AND 00000378 MVC 1(3,R1),FSCBFT START OF FILETYPE 00000379 USEFT EQU * 00000380 EJECT 00000381 * 00000382 * OPEN MAC FILE FOR OUTPUT 00000383 * 00000384 MVC SENDDATA(2),=C'OO' "OO" TO OPEN FOR OUTPUT 00000385 TM FLAGS2,ASCXF ASCII XFER FORCED? 00000386 BO KEEPOO YES, KEEP "OO" COMMAND 00000387 TM FLAGS2,COMP COMPRESSION SUPPORTED? 00000388 BZ KEEPOO NO, KEEP "OO" COMMAND 00000389 * SUPPORT FOR COMPRESSION, 'AO', AND 'MO' WERE ADDED TOGETHER 00000390 * 'AO' ALLOWS THE MICRO TO CHOOSE THE TRANSFER TYPE; 00000391 * 'MO' REQUESTS A TRANSFER IN MACBINARY FORMAT 00000392 MVC SENDDATA(2),=C'AO' "AO" FOR ALTERNATE OUTPUT 00000393 KEEPOO TM FLAGS2,BINXF BINARY SPECIFIED? 00000394 BZ KEEPOPN NO, KEEP CURRENT COMMAND 00000395 MVC SENDDATA(2),=C'BO' "BO" FOR BINARY OUTPUT 00000396 NI FLAGS2,255-BINXF RESET FLAG 00000397 TM FLAGS2,MACBIN MACBINARY SPECIFIED? 00000398 BZ KEEPOPN NO, KEEP PLAIN BINARY 00000399 MVC SENDDATA(2),=C'MO' "MO" FOR MACBINARY OUTPUT 00000400 NI FLAGS2,255-MACBIN RESET FLAG 00000401 KEEPOPN MVC SENDDATA+2(4),SIZECHAR FOLLOWED BY SECTOR COUNT 00000402 CLI VERSDATA,C'C' DIFFERENT LENGTHS FOR CP/M 00000403 BE OPENCPM 00000404 MVC SENDDATA+6(14),DATECHAR FOLLOWED BY DATE AND TIME 00000405 MVC SENDDATA+20(17),MACID FOLLOWED BY MAC FILE ID 00000406 LA R1,37 R1 = MAXIMUM LENGTH 00000407 LA R2,SENDDATA+36 R2 -> LAST BYTE 00000408 B TRUNLP 00000409 SPACE 00000410 OPENCPM MVC SENDDATA+6(8),DATECHAR FOLLOWED BY DATE AND TIME 00000411 MVC SENDDATA+14(12),MACID FOLLOWED BY CP/M FILE ID 00000412 LA R1,26 R1 = MAXIMUM LENGTH 00000413 LA R2,SENDDATA+25 R2 -> LAST BYTE 00000414 TRUNLP CLI 0(R2),C' ' LOOP: ADJUST LENGTH TO REMOVE 00000415 BNE USELEN TRAILING BLANKS 00000416 BCTR R1,0 DECREMENT LENGTH 00000417 BCTR R2,0 DECREMENT ADDRESS 00000418 B TRUNLP 00000419 SPACE 00000420 USELEN STH R1,SENDLEN STORE COMPUTED LENGTH 00000421 TM FLAGS2,PRTXF PRINTING SPECIFIED? 00000422 BO USEPRT YES, MENU IS IRRELEVANT 00000423 TM FLAGS,NOMENU MENU SUPPRESSED? 00000424 BZ EXOPEN NO, CONTINUE 00000425 CLI VERSDATA,C'C' LIKEWISE IF CP/M 00000426 BE EXOPEN 00000427 LA R2,SENDDATA(R1) APPEND "*" AT END 00000428 MVI 0(R2),C'*' 00000429 LA R1,1(R1) INCREMENT LENGTH 00000430 STH R1,SENDLEN STORE UPDATED VALUE 00000431 B EXOPEN 00000432 SPACE 00000433 USEPRT CLI VERSDATA,C'C' IGNORE PRINTING IF CP/M 00000434 BE EXOPEN 00000435 LA R2,SENDDATA(R1) APPEND "." AT END 00000436 MVI 0(R2),C'.' 00000437 LA R1,1(R1) INCREMENT LENGTH 00000438 STH R1,SENDLEN STORE UPDATED VALUE 00000439 SPACE 00000440 EXOPEN EQU * 00000441 BAL R14,CPMCMMD EXECUTE COMMAND 00000442 L R1,=A(RECVDATA) R1 -> RESULT 00000443 CLC 0(2,R1),=C'BT' BINARY TRANSFER WANTED? 00000444 BE BINOPEN YES, SET FLAG 00000445 CLC 0(2,R1),=C'MT' MACBINARY TRANSFER WANTED? 00000446 BNE OPENRC NO, CHECK RC 00000447 OI FLAGS2,MACBIN SET MACBINARY FLAG 00000448 BINOPEN OI FLAGS2,BINXF SET BINARY FLAG 00000449 B WRBGN CONTINUE NORMALLY 00000450 SPACE 00000451 OPENRC BAL R14,READRC GET RETURN CODE IN R1 00000452 LTR R1,R1 IF ZERO, READY FOR DATA 00000453 BZ WRBGN 00000454 OPENERR EQU * ELSE END XFER MODE 00000455 LR R2,R1 COPY RC FOR LINEDIT 00000456 LA R1,2 COMMAND LENGTH IS 2 00000457 STH R1,SENDLEN 00000458 MVC SENDDATA(2),=C'EX' "EXIT" COMMAND 00000459 BAL R14,CPMCMMD EXECUTE COMMAND, IGNORE RESULTS 00000460 BAL R14,ENDFS END FULL-SCREEN MODE 00000461 C R2,=F'1' ERROR 1 IS CP/M FILE EXISTS 00000462 BE NOFILE 00000463 C R2,=F'5' ERROR 5 IS XFER CANCELLED BY USER 00000464 BE USERQUIT 00000465 * ELSE TYPE ERROR NUMBER 00000466 LINEDIT TEXT='DMSWMC004E Mac error .... opening ''.................'X00000467 '',SUB=(DEC,(R2),CHARA,MACID),DISP=ERRMSG,RENT=NO 00000468 LA R15,100(R2) STORE RETURN CODE & RETURN 00000469 ST R15,RTNCODE 00000470 B CMSRTN 00000471 SPACE 00000472 NOFILE EQU * 00000473 LINEDIT TEXT='DMSWMC005E Mac file ''.................'' alreadX00000474 y exists',SUB=(CHARA,MACID),DISP=ERRMSG 00000475 LA R15,100(R2) 00000476 ST R15,RTNCODE 00000477 B CMSRTN 00000478 SPACE 00000479 USERQUIT EQU * 00000480 LINEDIT TEXT='DMSWMC013E File transfer cancelled by user', X00000481 DISP=ERRMSG 00000482 MVI RTNCODE+3,24 00000483 B CMSRTN 00000484 EJECT 00000485 * 00000486 * READ AND PROCESS EACH LINE OF CMS FILE 00000487 * 00000488 WRBGN OI FLAGS,FINIS SET FLAG TO CALL FINIS 00000489 SR R4,R4 INIT. CP/M BLOCK NO. OFFSET 00000490 ST R4,BLOCKNO 00000491 OI FLAGS,BLNKLINE LAST LINE BLANK 00000492 TM FLAGS2,MACBIN MACBINARY TRANSFER? 00000493 BZ RDLOOP NO, READY FOR DATA 00000494 * READ FIRST 128 BYTES AND SEND "MH" (MACBINARY HEADER) COMMAND 00000495 MVC SENDDATA(2),=C'MH' STORE COMMAND 00000496 LA R1,130 STORE COMMAND LENGTH 00000497 STH R1,SENDLEN 00000498 LA R2,SENDDATA+2 R2 = OUTPUT POINTER 00000499 LA R3,128 R3 = NO. OF BYTES NEEDED 00000500 L R4,INPBUF R4 -> INPUT BUFFER 00000501 MHREADLP EQU * LOOP TO READ HEADER INFO. 00000502 FSREAD FSCB=INFILE,FORM=E READ NEXT LINE 00000503 LTR R15,R15 CHECK FOR ERRORS 00000504 BNZ RDRC 00000505 SR R5,R5 ASSUME ALL BYTES USED 00000506 L R6,FSCBNORD R6 = NO. OF BYTES READ 00000507 CR R6,R3 MORE THAN WE NEED? 00000508 BNH MHKEEPRD NO, KEEP LENGTH 00000509 LR R5,R6 R5 = NO. OF UNUSED BYTES 00000510 SR R5,R3 00000511 LR R6,R3 USE HOW MANY WE NEED 00000512 MHKEEPRD BCTR R6,0 DECREMENT FOR EX 00000513 EX R6,MHMVC MOVE DATA TO BUFFER 00000514 LA R6,1(R6) RESTORE LENGTH MOVED 00000515 LA R2,0(R2,R6) UPDATE OUTPUT POINTER 00000516 SR R3,R6 UPDATE BYTES NEEDED 00000517 BNZ MHREADLP REPEAT IF MORE NEEDED 00000518 BAL R14,CPMCMMD ISSUE MH COMMAND 00000519 BAL R14,READRC GET RETURN CODE IN R1 00000520 LTR R1,R1 IF NON-ZERO, HANDLE AS OPEN ERROR 00000521 BNZ OPENERR 00000522 LTR R5,R5 ANY UNUSED BYTES? 00000523 BZ RDLOOP NO, CONTINUE NORMALLY 00000524 OI FLAGS,RDREC INDICATE DATA READ 00000525 LR R0,R4 R0 -> DESTINATION 00000526 LA R2,0(R4,R6) R2 -> SOURCE 00000527 LR R1,R5 R1, R3 = COUNT 00000528 LR R3,R5 00000529 MVCL R0,R2 MOVE EXTRA DATA TO BUFFER START 00000530 LR R1,R5 R1 = BYTE COUNT 00000531 B RDLPROC ENTER READ LOOP 00000532 SPACE 00000533 MHMVC MVC 0(*-*,R2),0(R4) MOVE FILE DATA TO COMMAND 00000534 SPACE 00000535 RDLOOP EQU * LOOP TO READ INPUT LINES: 00000536 FSREAD FSCB=INFILE,FORM=E CALL FSREAD 00000537 LTR R15,R15 EXIT IF READ NOT SUCCESSFUL 00000538 BNZ RDEND 00000539 OI FLAGS,RDREC INDICATE DATA READ 00000540 L R1,FSCBNORD R1 = NO. OF BYTES READ 00000541 RDLPROC BAL R14,PROCLINE CALL PROCLINE 00000542 B RDLOOP TRY TO READ ANOTHER LINE 00000543 SPACE 00000544 RDEND C R15,=F'12' TYPE MESSAGE IF NOT EOF 00000545 BE RDCHK 00000546 RDRC LR R3,R15 COPY ERROR CODE FOR LINEDIT 00000547 LA R1,SUBCODE R1 -> STRING 00000548 LA R2,1 R2 = LENGTH 00000549 BAL R14,WRITE TELL VMXFER TO CALL "SUBSET" 00000550 BAL R14,ENDFS 00000551 LINEDIT TEXT='DMSWMC104S Error ''.....'' reading file ''......X00000552 ..............'' from disk', X00000553 SUB=(DEC,(R3),CHAR8A,FSCBFN),DISP=ERRMSG,RENT=NO 00000554 BAL R14,BEGINFS 00000555 LA R1,SUBCODE R1 -> STRING 00000556 LA R2,1 R2 = LENGTH 00000557 BAL R14,WRITE TELL VMXFER TO EXIT "SUBSET" 00000558 LA R15,100 STORE RETURN CODE 00000559 ST R15,RTNCODE 00000560 RDCHK TM FLAGS,RDREC SKIP TO CLOSE IF A RECORD WAS 00000561 BZ WRCLOSE NEVER READ 00000562 TM FLAGS2,BINXF BINARY TRANSFER? 00000563 BZ WREOF NO, ADD CP/M EOF CHARACTER 00000564 L R2,BUFSIZE ANY CHARACTERS LEFT IN BUFFER? 00000565 LTR R2,R2 NO, READY FOR CLOSE 00000566 BZ WRCLOSE 00000567 BAL R14,WRCMMD ELSE WRITE REMAINING DATA 00000568 B WRCLOSE SEND CLOSE COMMAND 00000569 SPACE 00000570 WREOF L R2,BUFSIZE R2 = BYTES IN BUFFER 00000571 C R2,PCKSIZE IF FULL, WRITE BUFFER 00000572 BL WRAPP 00000573 BAL R14,WRCMMD WRITE BUFFER TO CP/M 00000574 SR R2,R2 RESET BYTE COUNT 00000575 ST R2,BUFSIZE 00000576 WRAPP EQU * ADD CTL-Z TO END OF BUFFER 00000577 LA R1,SENDDATA+6 R1 -> NEXT AVAILABLE BYTE 00000578 TM FLAGS,XFS INCLUDING XFSPEED? 00000579 BZ KEEPNXT1 NO, KEEP AS IS 00000580 LA R1,SENDDATA+10 ELSE ADJUST FOR SPEED BYTES 00000581 KEEPNXT1 A R1,BUFSIZE 00000582 MVI 0(R1),X'3F' STORE CP/M EOF CODE 00000583 L R2,BUFSIZE UPDATE BUFFER SIZE 00000584 LA R2,1(R2) 00000585 ST R2,BUFSIZE 00000586 BAL R14,WRCMMD WRITE BUFFER TO CP/M 00000587 WRCLOSE EQU * CLOSE CP/M FILE 00000588 LA R1,2 COMMAND LENGTH IS 2 00000589 STH R1,SENDLEN 00000590 MVC SENDDATA(2),=C'CO' CLOSE OUTPUT FILE 00000591 BAL R14,CPMCMMD EXECUTE COMMAND 00000592 BAL R14,READRC GET RETURN CODE IN R1 00000593 LTR R1,R1 TYPE MESSAGE IF NOT ZERO 00000594 BZ WREXIT 00000595 LR R3,R1 COPY RETURN CODE FOR LINEDIT 00000596 LA R1,SUBCODE R1 -> STRING 00000597 LA R2,1 R2 = LENGTH 00000598 BAL R14,WRITE TELL VMXFER TO CALL "SUBSET" 00000599 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00000600 LINEDIT TEXT='DMSWMC009E Error ...... from Mac close', X00000601 SUB=(DEC,(R3)),DISP=ERRMSG 00000602 LA R15,100(R3) STORE RETURN CODE 00000603 ST R15,RTNCODE 00000604 BAL R14,BEGINFS RESTORE FULL-SCREEN MODE 00000605 LA R1,SUBCODE R1 -> STRING 00000606 LA R2,1 R2 = LENGTH 00000607 BAL R14,WRITE TELL VMXFER TO EXIT "SUBSET" 00000608 WREXIT LA R1,2 COMMAND LENGTH IS 2 00000609 STH R1,SENDLEN 00000610 MVC SENDDATA(2),=C'EX' "EXIT" COMMAND 00000611 BAL R14,CPMCMMD EXECUTE COMMAND, IGNORE RESULTS 00000612 * B CMSRTN RETURN TO CMS 00000613 SPACE 00000614 * 00000615 * RETURN TO CMS 00000616 * 00000617 CMSRTN TM FLAGS2,TERMINIT TERMINAL TYPE KNOWN? 00000618 BZ RTNCLOSE NO, SKIP CLEANUP 00000619 TM TRMFLAGS,GRAFTRM 3270 TERMINAL? 00000620 BO RTN3270 YES, END FULL-SCREEN MODE 00000621 * CLEANUP FOR ASCII: 00000622 LINEDIT TEXT='SET LINEDIT ON',DOT=NO,DISP=CPCOMM 00000623 LINEDIT TEXT='TERM LINESIZE 80',DOT=NO,DISP=CPCOMM 00000624 CLC NODEID(8),BROWNID SKIP PROMPT COMMAND IF NOT BROWN 00000625 BNE PRSKIP1 00000626 LINEDIT TEXT='TERM PROMPT ON',DOT=NO,DISP=CPCOMM 00000627 PRSKIP1 EQU * 00000628 DMSEXS MVC,AINTRTBL(4),INTAB RESTORE XLATE TABLES 00000629 DMSEXS MVC,AOUTRTBL(4),OUTTAB 00000630 B RTNCLOSE 00000631 SPACE 00000632 RTN3270 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00000633 RTNCLOSE TM FLAGS,FINIS 00000634 BZ NOTOPEN 00000635 FSCLOSE '* * *' FORCE FILE TO BE CLOSED 00000636 NOTOPEN L R2,RETRYCNT TYPE NON-ZERO RETRY COUNT 00000637 LTR R2,R2 00000638 BZ NORETRY 00000639 LINEDIT TEXT='DMSWMC008I ...... block retransmission(s)', X00000640 SUB=(DEC,(R2)),DISP=ERRMSG 00000641 NORETRY TM FLAGS2,IOBUFF INPBUF ALLOCATED? 00000642 BZ NOFRET NO, SKIP FRET CALL 00000643 LM R0,R1,INPBUFDW GET R0, R1 FROM DMSFREE 00000644 DMSFRET DWORDS=(0),LOC=(1) RETURN STORAGE 00000645 NOFRET LM R0,R15,REGSAVE RESTORE REGISTERS AND RETURN 00000646 BR R14 00000647 EJECT 00000648 * 00000649 * PROCESS ONE LINE FROM CMS FILE 00000650 * 00000651 PROCLINE STM R0,R15,PRSAVE SAVE REGISTERS 00000652 DROP R9 WE USE R9 00000653 * R1 = NO. OF BYTES READ 00000654 L R6,INPBUF R6 -> INPUT BUFFER 00000655 LR R5,R1 COPY LENGTH TO R5 00000656 TM FLAGS2,BINXF BINARY TRANSFER? 00000657 BZ PROCTXT NO, CONTINUE WITH TEXT PROC. 00000658 B TXTLENOK READY TO USE LINE 00000659 SPACE 00000660 PROCTXT LTR R5,R5 NULL LINE? (SHOULDN'T HAPPEN) 00000661 BP LGOK NO, CONTINUE 00000662 MVI 0(R6),C' ' MOVE BLANK TO BUFFER 00000663 LA R5,1 AND MAKE LENGTH 1 00000664 LGOK EQU * TRANSLATE INVALID CHARACTERS TO "║" 00000665 L R0,=A(TRTABSTD) R5 -> STANDARD TRANSLATE TABLE 00000666 TM FLAGS3,ALTTR USE DIFFERENT TR FOR BROWN 00000667 BZ EXTR 00000668 L R0,=A(TRTABBRN) 00000669 EXTR LR R2,R5 R2 = LENGTH 00000670 LR R1,R6 R1 -> STRING 00000671 BAL R14,LONGTR TRANSLATE STRING 00000672 TM FLAGS,TEXT SPECIAL "TEXT" PROCESSING? 00000673 BZ NOTTEXT NO, CONTINUE NORMALLY 00000674 * ADJUST LENGTH TO DELETE TRAILING 00000675 * BLANKS 00000676 TXTLOOP EQU * LOOP TO FIND LAST NON-BLANK 00000677 LA R2,0(R5,R6) POINT TO NEXT BYTE FROM RIGHT 00000678 BCTR R2,0 00000679 CLI 0(R2),C' ' USE LENGTH IN R5 IF NON-BLANK 00000680 BNE TXTADD 00000681 BCT R5,TXTLOOP REPEAT 00000682 MVI 0(R6),X'0E' CONVERT BLANK LINE TO CR 00000683 LA R5,1 LENGTH FOR CR IS 1 00000684 CLI VERSDATA,C'C' CP/M SYSTEM? 00000685 BNE KEEPCR NO, CONTINUE 00000686 MVI 1(R6),X'0B' CONVERT BLANK LINE TO CR, LF 00000687 LA R5,2 LENGTH FOR CR, LF IS 2 00000688 KEEPCR TM FLAGS,TRUNCATE TRUNCATE OPTION? 00000689 BO TXTBLOK YES, SKIP BLNKLINE TEST 00000690 TM FLAGS,BLNKLINE WAS LAST LINE BLANK? 00000691 BO TXTBLOK IF SO, KEEP 1 CR 00000692 MVI 1(R6),X'0E' ELSE ADD ANOTHER CR 00000693 LA R5,2 00000694 CLI VERSDATA,C'C' CP/M SYSTEM? 00000695 BNE TXTBLOK NO, CONTINUE 00000696 MVI 1(R6),X'0B' RESTORE PREVIOUS LF 00000697 MVC 2(2,R6),=X'0E0B' ADD ANOTHER CR, LF 00000698 LA R5,4 00000699 TXTBLOK OI FLAGS,BLNKLINE REMEMBER HAD BLANK LINE 00000700 B TXTLENOK DONE WITH LINE 00000701 SPACE 00000702 TXTADD NI FLAGS,255-BLNKLINE REMEMBER LINE NOT BLANK 00000703 MVI 1(R2),C' ' APPEND BLANK AT END 00000704 LA R5,1(R5) SET NEW LENGTH 00000705 TM FLAGS,TRUNCATE TRUNCATE OPTION? 00000706 BZ TXTLENOK NO, ALL SET 00000707 MVI 1(R2),X'0E' APPEND LF AT END INSTEAD 00000708 CLI VERSDATA,C'C' CP/M SYSTEM? 00000709 BNE TXTLENOK NO, THEN ALL SET 00000710 MVI 2(R2),X'0B' ELSE NEED LF AFTER CR 00000711 LA R5,1(R5) 00000712 B TXTLENOK 00000713 SPACE 00000714 NOTTEXT LA R2,0(R5,R6) ADD SO (XLATED CR) AT END OF LINE 00000715 MVI 0(R2),X'0E' 00000716 LA R5,1(R5) 00000717 CLI VERSDATA,C'C' CP/M SYSTEM? 00000718 BNE TXTLENOK NO, CONTINUE 00000719 MVI 1(R2),X'0B' ALSO ADD LINEFEED 00000720 LA R5,1(R5) 00000721 TXTLENOK EQU * R5 = LENGTH, R6 -> INPUT BUFFER 00000722 REPEAT LTR R5,R5 ALL DONE IF LENGTH = 0 00000723 BNP PRRTN 00000724 L R7,BUFSIZE BUFFER FULL? 00000725 C R7,PCKSIZE 00000726 BL MOVDATA NO- WRITING BUFFER 00000727 BAL R14,WRCMMD WRITE BUFFER TO CP/M 00000728 SR R7,R7 RESET BYTE COUNT 00000729 ST R7,BUFSIZE 00000730 MOVDATA LR R8,R5 R8 = NO. OF BYTES TO MOVE 00000731 C R8,=F'256' CANNOT EXCEED 256 00000732 BNH MOVCONT (MVC RESTRICTION) 00000733 L R8,=F'256' 00000734 MOVCONT S R7,PCKSIZE R7 = BYTES LEFT IN BUFFER 00000735 LCR R7,R7 00000736 CR R7,R8 ADJUST BYTE COUNT IF BUFFER 00000737 BNL EXMOV WOULD OVERFLOW 00000738 LR R8,R7 00000739 EXMOV BCTR R8,0 DECREMENT FOR MVC 00000740 STC R8,MVC1+1 STORE LENGTH IN MVC 00000741 LA R9,SENDDATA+6 R9 -> NEXT AVAILABLE BYTE 00000742 TM FLAGS,XFS INCLUDING XFSPEED? 00000743 BZ KEEPNXT2 NO, KEEP AS IS 00000744 LA R9,SENDDATA+10 00000745 KEEPNXT2 EQU * 00000746 A R9,BUFSIZE IN BUFFER 00000747 MVC1 MVC 0(*-*,R9),0(R6) APPEND TO BUFFER 00000748 LA R8,1(R8) R8 = NO. OF BYTES MOVED 00000749 AR R6,R8 INCREMENT STRING ADDRESS 00000750 SR R5,R8 DECREMENT STRING LENGTH 00000751 L R7,BUFSIZE UPDATE BUFFER LENGTH 00000752 AR R7,R8 00000753 ST R7,BUFSIZE 00000754 B REPEAT CONTINUE UNTIL ALL BYTES TRANSFERRED 00000755 SPACE 00000756 PRRTN LM R0,R15,PRSAVE RESTORE REGISTERS 00000757 BR R14 RETURN TO CALLER 00000758 SPACE 00000759 PRSAVE DS 8D LOCAL SAVE AREA 00000760 USING FSCBD,R9 R9 OK FOR REST OF CODE 00000761 EJECT 00000762 * WRITE CMS FILE DATA TO CMS 00000763 SPACE 00000764 WRCMMD EQU * 00000765 LR R13,R14 COPY RETURN ADDRESS 00000766 MVC SENDDATA(6),=X'402120202020' CONVERT BLOCK NUMBER 00000767 L R4,BLOCKNO 00000768 CVD R4,DECBUF 00000769 ED SENDDATA(6),DECBUF+5 00000770 MVC SENDDATA(2),=C'WB' STORE WRITE BLOCK COMMAND 00000771 LA R4,1(R4) INCREMENT BLOCK NUMBER 00000772 ST R4,BLOCKNO 00000773 LA R1,6 GET TOTAL LENGTH 00000774 TM FLAGS,XFS IS XFSPEED SUPPORTED? 00000775 BZ NOSPEED NO, KEEP JUST BLOCK NO. 00000776 MVC SENDDATA+6(4),XFSPEED APPEND XFSPEED 00000777 LA R1,10 CHANGE LENGTH TO 10 00000778 NOSPEED EQU * 00000779 A R1,BUFSIZE 00000780 STH R1,SENDLEN STORE COMMAND LENGTH 00000781 BAL R14,CPMCMMD EXECUTE COMMAND 00000782 BAL R14,READRC GET RETURN CODE IN R1 00000783 LTR R1,R1 IF NON-ZERO, HANDLE ERROR 00000784 BNZ WCMDERR 00000785 CLC BLOCKNO(4),=F'1' DID WE JUST SEND FIRST BLOCK? 00000786 BNER R13 NO, READY TO RETURN 00000787 TM FLAGS,XFS XFSPEED SUPPORTED? 00000788 BZR R13 NO, JUST RETURN 00000789 MVC SENDDATA(2),=C'TT' STORE TRANSFER TIME COMMAND 00000790 MVC SENDDATA+2(4),XFSPEED APPEND XFSPEED 00000791 LA R1,6 STORE COMMAND LENGTH 00000792 STH R1,SENDLEN 00000793 BAL R14,CPMCMMD EXECUTE COMMAND 00000794 BAL R14,READRC GET RETURN CODE AND IGNORE 00000795 BR R13 RETURN TO CALLER 00000796 SPACE 00000797 WCMDERR LR R3,R1 COPY RETURN CODE FOR LINEDIT 00000798 LA R1,SUBCODE R1 -> STRING 00000799 LA R2,1 R2 = LENGTH 00000800 BAL R14,WRITE TELL VMXFER TO CALL "SUBSET" 00000801 BAL R14,ENDFS END FULL-SCREEN MODE 00000802 C R3,=F'11' CHECK FOR USER ABORT 00000803 BE USRABORT 00000804 LINEDIT TEXT='DMSWMC006E Error ...... from Mac write', X00000805 SUB=(DEC,(R3)),DISP=ERRMSG 00000806 LA R15,100(R3) STORE RETURN CODE 00000807 ST R15,RTNCODE 00000808 BAL R14,BEGINFS RESTORE FULL-SCREEN MODE 00000809 LA R1,SUBCODE R1 -> STRING 00000810 LA R2,1 R2 = LENGTH 00000811 BAL R14,WRITE TELL VMXFER TO EXIT "SUBSET" 00000812 B WRCLOSE CLOSE CP/M FILE AND RETURN TO CMS 00000813 SPACE 00000814 USRABORT LINEDIT TEXT='DMSWMC011E Transfer aborted by user', X00000815 DISP=ERRMSG 00000816 LA R15,100(R3) STORE RETURN CODE 00000817 ST R15,RTNCODE 00000818 BAL R14,BEGINFS RESTORE FULL-SCREEN MODE 00000819 LA R1,SUBCODE R1 -> STRING 00000820 LA R2,1 R2 = LENGTH 00000821 BAL R14,WRITE TELL VMXFER TO EXIT "SUBSET" 00000822 B WRCLOSE CLOSE CP/M FILE AND RETURN TO CMS 00000823 EJECT 00000824 * SEND COMMAND TO CP/M SYSTEM AND 00000825 * READ RESPONSE 00000826 CPMCMMD EQU * 00000827 STM R0,R15,CMMDSAVE SAVE REGISTERS 00000828 SR R4,R4 RETRY COUNT = 0 00000829 LH R0,SENDLEN CALCULATE CHECKSUM (4 BYTES) 00000830 LA R1,SENDDATA 00000831 BAL R14,CHKCALC RESULT BYTES ARE IN R2 00000832 * APPEND CHECKSUM TO SENDDATA 00000833 AR R1,R0 R1 -> AFTER LAST BYTE OF DATA 00000834 MVI 0(R1),X'01' STORE CHECKSUM DELIMITER 00000835 LA R1,1(R1) STORE CHECKSUM BYTES 00000836 STCM R2,B'1111',0(R1) 00000837 LH R2,SENDLEN ADD 5 TO LENGTH 00000838 LA R2,5(R2) (DELIMITER, 4-BYTE CHECKSUM) 00000839 STH R2,SENDLEN 00000840 ST R2,ORIGSIZE SAVE ORIGINAL SIZE 00000841 TM TRMFLAGS,MAC3270 APPLETALK CONNECTION 00000842 BO CMDCTEST YES, KEEP SIZE 00000843 LA R2,2(R2) INCLUDE START BYTES IN COUNT 00000844 ST R2,ORIGSIZE STORE NEW SIZE 00000845 LH R2,SENDLEN RESTORE ORIGINAL SIZE 00000846 CMDCTEST LA R1,SENDDATA R1 -> DATA (LENGTH IN R2) 00000847 TM FLAGS2,COMP COMPRESSION SUPPORTED? 00000848 BZ CMDBIN NO, CHECK FOR BINARY 00000849 BAL R14,COMPRESS TRY TO COMPRESS DATA 00000850 STH R2,SENDLEN STORE UPDATED LENGTH 00000851 CMDBIN TM FLAGS2,BINXF BINARY TRANSFER? 00000852 BZ CMDLOOP NO, CONTINUE NORMALLY 00000853 TM FLAGS2,ASCBIN BINARY USING ASCBIN SUPPORT? 00000854 BZ CMDLOOP NO, CONTINUE NORMALLY 00000855 BAL R14,WRITABIN SPECIAL ASCBIN CONVERSION 00000856 STH R2,SENDLEN STORE UPDATED LENGTH 00000857 CMDLOOP L R2,=A(RECVDATA) R2 -> RESPONSE BUFFER 00000858 XC 0(8,R2),0(R2) RESET START OF BUFFER 00000859 LH R2,SENDLEN GET LENGTH FOR WRITE 00000860 TM TRMFLAGS,MAC3270 APPLETALK CONNECTION? 00000861 BZ CMDSCODE NO, NEED START CODES 00000862 LA R1,SENDDATA ELSE JUST RESTORE R1 -> DATA 00000863 B CMDSOK 00000864 SPACE 00000865 CMDSCODE LA R2,2(R2) ADJUST FOR START BYTE CODES 00000866 LA R1,SENDSTRT R1 -> FIRST BYTE 00000867 CMDSOK EQU * START CODE ADDED, IF NEEDED 00000868 STCK STRTTIME SAVE TOD CLOCK FOR RATE CALC. 00000869 MVC WRCNT(4),ORIGSIZE SAVE ORIGINAL BYTE COUNT 00000870 BAL R14,WRITERD WRITE DATA TO TERMINAL 00000871 * ALSO READ RESPONSE IF 3270 00000872 TM TRMFLAGS,GRAFTRM 3270 TERMINAL? 00000873 BO SKIPREAD RDTERM NOT NEEDED 00000874 L R3,=A(RECVDATA) R3 -> BUFFER 00000875 RDTERM (R3),EDIT=PHYS,LENGTH=1032 READ RESPONSE 00000876 STH R0,RECVLEN 00000877 SKIPREAD LH R0,RECVLEN READ LENGTH IN R0 00000878 ST R0,RDCNT SAVE BYTE COUNT 00000879 STCK ENDTIME SAVE TOD CLOCK FOR RATE CALC. 00000880 C R0,=F'6' ERROR IF < 6 BYTES 00000881 BL RETRY 00000882 L R1,=A(RECVDATA) CHECK FOR CHECKSUM DELIMITER 00000883 AR R1,R0 00000884 S R1,=F'5' R1 -> WHERE DELIMITER SHOULD BE 00000885 CLI 0(R1),X'01' RETRY IF NOT THERE 00000886 BNE RETRY 00000887 SR R3,R3 GET CHECKSUM BYTES IN R3 00000888 ICM R3,B'1111',1(R1) 00000889 S R0,=F'5' R0 = DATA LENGTH 00000890 STH R0,RECVLEN SAVE LENGTH 00000891 L R1,=A(RECVDATA) R1 -> DATA 00000892 BAL R14,CHKCALC GET CHECKSUM BYTES IN R2 00000893 CR R2,R3 IF MATCH, USE DATA 00000894 BE CMDRTN 00000895 RETRY C R4,=F'5' RETRY LIMIT REACHED? 00000896 BNL ABORT IF SO, ABORT XFER 00000897 LA R4,1(R4) INCREMENT COUNT 00000898 L R1,RETRYCNT INCREMENT GLOBAL COUNT 00000899 LA R1,1(R1) 00000900 ST R1,RETRYCNT 00000901 LA R1,SUBCODE R1 -> STRING 00000902 LA R2,1 R2 = LENGTH 00000903 BAL R14,WRITE TELL VMXFER TO CALL "SUBSET" 00000904 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00000905 WRTERM RETRYMSG,RMSGL,EDIT=NO TYPE MESSAGE TO USER 00000906 BAL R14,BEGINFS RESUME FULL-SCREEN MODE 00000907 LA R1,SUBCODE R1 -> STRING 00000908 LA R2,1 R2 = LENGTH 00000909 BAL R14,WRITE TELL VMXFER TO EXIT "SUBSET" 00000910 B CMDLOOP SEND COMMAND AGAIN 00000911 SPACE 1 00000912 CMDRTN BAL R14,TIMEUPD UPDATE XFER RATE 00000913 BAL R14,SUBCHK CHECK FOR SUBSET MODE 00000914 BNZ CMDLOOP IF SUBSET, REPEAT COMMAND 00000915 LM R0,R15,CMMDSAVE RESTORE REGISTERS 00000916 BR R14 RETURN TO CALLER 00000917 SPACE 00000918 ABORT LA R1,ABORTSTR R1 -> STRING 00000919 CLI VERSDATA,C'C' CP/M SYSTEM? 00000920 BNE ASTROK NO, KEEP ABORTSTR 00000921 LA R1,ABRTSTRC USE DIFFERENT STRING 00000922 ASTROK LA R2,3 R2 = LENGTH 00000923 BAL R14,WRITE SEND ABORT COMMAND 00000924 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00000925 LINEDIT TEXT='DMSWMC007E Retry count exceeded', X00000926 DISP=ERRMSG 00000927 LA R15,256 STORE RETURN CODE 00000928 ST R15,RTNCODE 00000929 B CMSRTN RETURN TO CMS 00000930 SPACE 00000931 CMMDSAVE DS 8D LOCAL SAVE AREA 00000932 ORIGSIZE DS 1F ORIGINAL SIZE FOR TIMING 00000933 EJECT 00000934 * RETURN RC IN RECVDATA BUFFER 00000935 * OR 999 IF NO VALID RC 00000936 READRC EQU * 00000937 STM R2,R15,RCSAVE SAVE REGISTERS 00000938 LA R1,999 SET DEFAULT RETURN CODE 00000939 LH R2,RECVLEN MUST HAVE AT LEAST 6 BYTES 00000940 C R2,=F'6' 00000941 BL RCRTN 00000942 L R4,=A(RECVDATA) R4 -> BUFFER 00000943 CLC 0(2,R4),=C'RC' MUST START WITH "RC" 00000944 BNE RCRTN 00000945 LA R3,4 R3 = DIGIT COUNT 00000946 LA R4,2(R4) R4 -> FIRST DIGIT 00000947 SR R5,R5 R5 = RESULT 00000948 CVTLOOP EQU * 00000949 CLI 0(R4),C'0' CHECK FOR VALID DIGIT 00000950 BL RCRTN 00000951 CLI 0(R4),C'9' 00000952 BH RCRTN 00000953 SR R6,R6 CONVERT DIGIT TO BINARY 00000954 IC R6,0(R4) 00000955 S R6,=F'240' 00000956 CVTMULT MH R5,=H'10' RESULT = RESULT*10 + DIGIT 00000957 AR R5,R6 00000958 LA R4,1(R4) R4 -> NEXT DIGIT 00000959 BCT R3,CVTLOOP REPEAT FOR EACH DIGIT 00000960 LR R1,R5 COPY RESULT INTO R1 00000961 RCRTN LM R2,R15,RCSAVE RESTORE REGISTERS 00000962 BR R14 00000963 SPACE 00000964 RCSAVE DS 7D LOCAL SAVE AREA 00000965 EJECT 00000966 * CALCULATE CHECKSUM FOR STRING: R0 = LENGTH, R1 -> CHARACTERS. 00000967 * FOUR-BYTE CHECKSUM RETURNED IN R2. 00000968 CHKCALC EQU * 00000969 STM R0,R15,CHKSAVE SAVE REGISTERS 00000970 SR R5,R5 CHECKSUM = 0 00000971 STC R5,CHKFLAG FLAGS = 0 00000972 L R3,=A(TOASCSTD) R3 -> TRANSLATE TABLE 00000973 TM FLAGS3,ALTTR IF BROWN, USE SPECIAL TABLE 00000974 BZ CHKBINCK 00000975 L R3,=A(TOASCBRN) 00000976 CHKBINCK TM FLAGS2,BINXF BINARY XFER? 00000977 BZ CHKZERO NO, CONTINUE NORMALLY 00000978 C R0,=F'2' AT LEAST 2 CHARACTERS? 00000979 BL CHKZERO NO, CONTINUE NORMALLY 00000980 CLC 0(2,R1),=C'WB' WB COMMAND? 00000981 BNE CHKMH NO, CONTINUE 00000982 OI CHKFLAG,CHKBIN SUPPRESS TRANSLATION 00000983 TR 0(6,R1),0(R3) TRANSLATE 'WB' AND BLOCK NUMBER 00000984 TM FLAGS,XFS INCLUDING XFSPEED? 00000985 BZ CHKZERO NO, KEEP AS IS 00000986 TR 6(4,R1),0(R3) ELSE TRANSLATE SPEED AS WELL 00000987 B CHKZERO 00000988 SPACE 00000989 CHKMH CLC 0(2,R1),=C'MH' MH COMMAND? 00000990 BNE CHKZERO NO, KEEP AS IS 00000991 OI CHKFLAG,CHKBIN SUPPRESS TRANSLATION 00000992 TR 0(2,R1),0(R3) TRANSLATE 'MH' 00000993 CHKZERO LTR R7,R0 00000994 BZ CHKCVT IF LENGTH 0, KEEP 0 CHECKSUM 00000995 LR R6,R1 R6 -> FIRST BYTE, R7 = BCT COUNT 00000996 L R8,=V(CRCTAB) R8 -> CRCTAB 00000997 CHKLOOP EQU * LOOP TO PROCESS EACH BYTE 00000998 SR R4,R4 R4 = DATA BYTE 00000999 IC R4,0(R6) 00001000 TM CHKFLAG,CHKBIN BINARY DATA? 00001001 BO CHKXOR YES, SKIP TRANSLATION 00001002 IC R4,0(R3,R4) TRANSLATE TO ASCII 00001003 CHKXOR XR R4,R5 XOR WITH LOW CHECKSUM BYTE 00001004 N R4,=X'000000FF' 00001005 SRL R5,8 SHIFT CRC RIGHT 8 BITS 00001006 SLL R4,1 GET TABLE INDEX 00001007 LH R4,0(R4,R8) R4 = HALFWORD FROM TABLE 00001008 N R4,=X'0000FFFF' 00001009 XR R5,R4 XOR WITH CHECKSUM 00001010 LA R6,1(R6) R6 -> NEXT BYTE 00001011 BCT R7,CHKLOOP CONTINUE TO END 00001012 CHKCVT STCM R5,B'0011',CHKDATA STORE FINAL CHECKSUM 00001013 UNPK CHKCHAR(5),CHKDATA(3) CONVERT TO HEX CHARS. 00001014 TR CHKCHAR(4),HEXCHARS-240 00001015 MVC CHKSAVE+8(4),CHKCHAR RETURN RESULT IN R2 00001016 LM R0,R15,CHKSAVE RESTORE REGISTERS 00001017 BR R14 00001018 CHKSAVE DS 8D LOCAL SAVE AREA 00001019 HEXCHARS DC C'0123456789ABCDEF' CHARACTERS FOR HEX CONVERSION 00001020 CHKDATA DS 2X CHECKSUM BYTES 00001021 DS 1X EXTRA BYTE FOR UNPK 00001022 CHKCHAR DS 5X CHARACTER CHECKSUM 00001023 CHKFLAG DS 1X LOCAL FLAG BYTE 00001024 CHKBIN EQU X'01' BINARY DATA 00001025 EJECT 00001026 * 00001027 * "COMPRESS" ATTEMPTS TO COMPRESS THE DATA TO BE TRANSMITTED. 00001028 * A STRING OF BETWEEN 3 AND 97 REPEATED CHARACTERS IS COMPRESSED 00001029 * TO 3 CHARACTERS (THE CHARACTER FOLLOWED BY X'18' AND A COUNT). 00001030 * 00001031 COMPRESS DS 0H 00001032 C R2,=F'8' AT LEAST 3 DATA BYTES? 00001033 BLR R14 NO, SKIP COMPRESSION 00001034 STM R0,R15,COMPSAVE SAVE REGISTERS 00001035 SR R8,R8 R8 -> TRANSLATE TABLE 00001036 TM FLAGS2,BINXF BINARY TRANSFER? 00001037 BZ CSETTAB NO, NEED TO TRANSLATE 00001038 CLC 0(2,R1),=X'5742' ASCII WB COMMAND? 00001039 BE CTABOK YES, KEEP R8 = 0 00001040 CLC 0(2,R1),=X'4D48' ASCII MH COMMAND? 00001041 BE CTABOK YES, KEEP R8 = 0 00001042 CSETTAB L R8,=A(FRASCSTD) GET A(ASCII TO EBCDIC) 00001043 TM FLAGS3,ALTTR NEED BROWN'S TABLE? 00001044 BZ CTABOK NO, CONTINUE 00001045 L R8,=A(FRASCBRN) R8 -> BROWN'S TABLE 00001046 CTABOK EQU * R8 -> TABLE, OR ZERO 00001047 S R2,=F'5' OMIT CD, CRC FROM LENGTH 00001048 LR R7,R2 SAVE ORIG. LENGTH IN R7 00001049 L R3,=A(GRAFDATA) R3 -> OUTPUT BUFFER 00001050 SR R4,R4 R4 = OUTPUT LENGTH 00001051 * OUTPUT X'18' PREFIX 00001052 MVI 0(R3),X'18' STORE PREFIX CHARACTER 00001053 LA R3,1(R3) INCREMENT ADDRESS 00001054 LA R4,1(R4) INCREMENT COUNT 00001055 * OUTPUT FIRST CHARACTER 00001056 SR R6,R6 R6 = NEW CHARACTER 00001057 IC R6,0(R1) 00001058 BAL R9,CPUTCHR CALL OUTPUT ROUTINE 00001059 LA R1,1(R1) INCREMENT INPUT POINTER 00001060 BCTR R2,0 DECREMENT INPUT LENGTH 00001061 SR R5,R5 STATE = 0 00001062 COMPLOOP EQU * LOOP FOR COMPRESSION 00001063 LR R0,R6 PREVIOUS = NEW CHARACTER 00001064 IC R6,0(R1) R6 = NEW CHARACTER 00001065 LTR R5,R5 STATE 0? 00001066 BZ CSTATE0 YES, GO HANDLE 00001067 C R5,=F'1' STATE 1? 00001068 BE CSTATE1 YES, GO HANDLE 00001069 B CSTATE2 ELSE MUST BE STATE 2 00001070 SPACE 00001071 CSTATE0 EQU * NORMAL STATE 00001072 CR R6,R0 NEW CHAR. SAME AS PREVIOUS? 00001073 BE S0SAME YES, SAVE IT 00001074 BAL R9,CPUTCHR OUTPUT CHARACTER 00001075 B CMPLEND READY FOR NEXT CHARACTER 00001076 SPACE 00001077 S0SAME LA R5,1 STATE = 1 00001078 B CMPLEND READY FOR NEXT CHARACTER 00001079 SPACE 00001080 CSTATE1 EQU * LAST CHAR. SAME AS PREVIOUS 00001081 CR R6,R0 NEW CHAR. SAME AS PREVIOUS? 00001082 BE S1SAME YES, SAVE IT 00001083 ST R6,NEWCHAR SAVE NEW CHARACTER 00001084 LR R6,R0 R6 = PREVIOUS CHARACTER 00001085 BAL R9,CPUTCHR OUTPUT PREVIOUS CHARACTER 00001086 L R6,NEWCHAR RESTORE NEW CHARACTER 00001087 BAL R9,CPUTCHR OUTPUT NEW CHARACTER 00001088 SR R5,R5 NEW STATE = 0 00001089 B CMPLEND READY FOR NEXT CHARACTER 00001090 SPACE 00001091 S1SAME LA R9,3 SET COUNT TO 3 00001092 ST R9,CMPCOUNT 00001093 LA R5,2 NEW STATE = 2 00001094 B CMPLEND READY FOR NEXT CHARACTER 00001095 SPACE 00001096 CSTATE2 EQU * LAST "COUNT" CHARS. SAME 00001097 L R9,CMPCOUNT R9 = CURRENT COUNT 00001098 C R9,=F'97' COUNT UP TO 97? 00001099 BE S2DIFF YES, TREAT AS STRING END 00001100 CR R6,R0 NEW CHAR. SAME AS PREVIOUS 00001101 BNE S2DIFF YES, HANDLE STRING END 00001102 LA R9,1(R9) INCREMENT COUNT 00001103 ST R9,CMPCOUNT 00001104 B CMPLEND READY FOR NEXT CHARACTER 00001105 SPACE 00001106 S2DIFF MVI 0(R3),X'18' OUTPUT X'18' 00001107 LA R3,1(R3) INC. OUTPUT POINTER 00001108 LA R4,1(R4) INC. OUTPUT LENGTH 00001109 ST R6,NEWCHAR SAVE NEW CHARACTER 00001110 LA R6,29(R9) COUNT -> ASCII IN R6 00001111 LTR R8,R8 TRANSLATION NEEDED? 00001112 BZ S2USECNT NO, KEEP COUNT 00001113 IC R6,0(R6,R8) TRANSLATE TO EBCDIC 00001114 S2USECNT BAL R9,CPUTCHR OUTPUT COUNT 00001115 L R6,NEWCHAR RESTORE NEW CHARACTER 00001116 BAL R9,CPUTCHR OUTPUT NEW CHARACTER 00001117 SR R5,R5 NEW STATE = 0 00001118 CMPLEND EQU * COMMON END OF LOOP 00001119 LA R1,1(R1) INCREMENT INPUT POINTER 00001120 BCT R2,COMPLOOP REPEAT FOR INPUT LENGTH 00001121 * CLEAN UP AFTER LAST CHARACTER 00001122 LTR R5,R5 LAST STATE 0? 00001123 BZ CMPFIN YES, READY TO FINISH 00001124 C R5,=F'1' LAST STATE 1? 00001125 BE CMPCL1 YES, GO CLEANUP 00001126 B CMPCL2 ELSE MUST BE STATE 2 00001127 SPACE 00001128 CMPCL1 EQU * CLEAN UP AFTER STATE 1 00001129 BAL R9,CPUTCHR OUTPUT 2ND COPY OF CHARACTER 00001130 B CMPFIN READY TO FINISH 00001131 SPACE 00001132 CMPCL2 EQU * CLEAN UP AFTER STATE 2 00001133 MVI 0(R3),X'18' OUTPUT X'18' 00001134 LA R3,1(R3) INC. OUTPUT POINTER 00001135 LA R4,1(R4) INC. OUTPUT LENGTH 00001136 LA R6,29(R9) COUNT -> ASCII IN R6 00001137 LTR R8,R8 TRANSLATION NEEDED? 00001138 BZ C2USECNT NO, KEEP COUNT 00001139 IC R6,0(R6,R8) TRANSLATE TO EBCDIC 00001140 C2USECNT BAL R9,CPUTCHR OUTPUT COUNT 00001141 SPACE 00001142 CMPFIN EQU * FINISH- COPY DATA, CRC 00001143 MVC CRCSAVE(5),0(R1) SAVE CD, CRC 00001144 L R0,COMPSAVE+4 R0 -> INPUT BUFFER 00001145 L R2,=A(GRAFDATA) R2 -> OUTPUT BUFFER 00001146 LR R1,R4 R1, R3 = FINAL LENGTH 00001147 LR R3,R4 00001148 MVCL R0,R2 SUBSTITUTE COMPRESSED DATA 00001149 LR R1,R0 R1 -> AFTER DATA 00001150 MVC 0(5,R1),CRCSAVE APPEND CD, CRC 00001151 LA R4,5(R4) R4 = LENGTH WITH CD, CRC 00001152 ST R4,COMPSAVE+8 STORE NEW LENGTH FOR R2 00001153 LM R0,R15,COMPSAVE RESTORE REGISTERS 00001154 BR R14 RETURN 00001155 SPACE 00001156 CPUTCHR EQU * OUTPUT CHARACTER IN R6 00001157 STC R6,0(R3) STORE IN OUTPUT BUFFER 00001158 LA R3,1(R3) INC. OUTPUT POINTER 00001159 LA R4,1(R4) INC. OUTPUT LENGTH 00001160 C R6,COMPCHAR COMPRESSION CHARACTER? 00001161 BNE CPUTEND NO, DONE 00001162 STC R6,0(R3) OUTPUT CHARACTER AGAIN 00001163 LA R3,1(R3) INC. OUTPUT POINTER 00001164 LA R4,1(R4) INC. OUTPUT LENGTH 00001165 CPUTEND CR R4,R7 SMALLER THAN INPUT? 00001166 BLR R9 YES- RETURN 00001167 LM R0,R15,COMPSAVE NO- RETURN ORIG. STRING 00001168 BR R14 00001169 SPACE 00001170 COMPSAVE DS 8D REGISTER SAVE AREA 00001171 COMPCHAR DC A(X'18') COMPRESSION CHARACTER 00001172 NEWCHAR DS 1F SAVED NEW CHARACTER 00001173 CMPCOUNT DS 1F COMPRESSION COUNT 00001174 EJECT 00001175 * 00001176 * "WRITABIN" WRITES BINARY DATA TO TERM VIA A LINE MODE OR 7171 00001177 * CONNECTION. IT CHOOSES THE MOST EFFICIENT ENCODING METHOD, 00001178 * AND ENCODES THE OUTPUT DATA APPROPRIATELY. 00001179 * 00001180 WRITABIN DS 0H 00001181 STM R0,R15,WRITASAV SAVE REGISTERS 00001182 LR R3,R1 R3 = COPY OF ADDR. 00001183 LR R4,R2 R2 = COPY OF LENGTH 00001184 C R4,=F'6' AT LEAST ONE BYTE? 00001185 BL WRITAEND NO, HANDLE NORMALLY 00001186 CLI 0(R3),X'18' COMPRESSED LINE? 00001187 BNE WRWBCHK NO, KEEP ADDR., LENGTH 00001188 LA R3,1(R3) R3 -> PAST PREFIX 00001189 BCTR R4,0 R4 = NEW LENGTH 00001190 WRWBCHK C R4,=F'7' AT LEAST 2 DATA BYTES? 00001191 BL WRITAEND NO, HANDLE NORMALLY 00001192 CLC 0(2,R3),=X'5742' ASCII WB COMMAND? 00001193 BE WRISWB YES, DO BINARY PROCESSING 00001194 CLC 0(2,R3),=X'4D48' ASCII MH COMMAND? 00001195 BNE WRITAEND NO, HANDLE NORMALLY 00001196 WRISWB LR R3,R2 R3 = TOTAL LENGTH 00001197 S R3,=F'5' R3 = DATA LENGTH 00001198 LA R2,0(R1) R2 -> FIRST DATA BYTE 00001199 L R4,=A(ABINDATA) R4 -> BUFFER 00001200 LR R5,R3 R5 = LENGTH 00001201 LR R6,R4 SAVE ADDRESS AND LENGTH 00001202 LR R7,R5 00001203 MVCL R4,R2 COPY DATA TO BUFFER 00001204 LR R1,R6 R1 -> DATA 00001205 LR R2,R7 R2 = LENGTH 00001206 L R0,=A(ABINTAB) R0 -> TABLE 00001207 BAL R14,LONGTR TRANSLATE DATA 00001208 SR R5,R5 R5 COUNTS QUOTED BYTES 00001209 BINCNTLP EQU * COUNT QUOTED BYTES 00001210 CLI 0(R1),X'15' CHECK FOR QUOTE VALUES 00001211 BE INCQUOTE 00001212 CLI 0(R1),X'16' 00001213 BNE BCNTNXT 00001214 INCQUOTE LA R5,1(R5) INCREMENT COUNT 00001215 BCNTNXT LA R1,1(R1) R1 -> NEXT BYTE 00001216 BCT R2,BINCNTLP REPEAT 00001217 LR R6,R7 R6 = TOTAL LENGTH 00001218 SR R6,R5 R6 = NORMAL BYTE COUNT 00001219 SLL R5,1 R5 = 2*QUOTED COUNT 00001220 LR R7,R5 SAVE IN R7 00001221 * MAKE COPY OF DATA 00001222 LM R2,R3,WRITASAV+4 R2 -> STRING, R3 = LENGTH 00001223 L R4,=A(GRAFDATA) USE GRAFDATA TEMPORARILY 00001224 LR R5,R3 00001225 MVCL R4,R2 COPY DATA 00001226 CR R7,R6 COMPARE COUNTS 00001227 BL DOQUOTE IF R7 LESS, USE QUOTING 00001228 DOPACK EQU * PACK DATA BYTES 00001229 LM R1,R2,WRITASAV+4 RESTORE R1, R2 00001230 LA R5,0(R1) R5 -> NEXT OUTPUT BYTE 00001231 S R2,=F'5' R2 = INPUT COUNT 00001232 LR R6,R2 COPY IN R6 00001233 L R4,=A(GRAFDATA) R4 -> INPUT DATA 00001234 MVI 0(R5),X'17' INDICATE PACKED DATA 00001235 LA R5,1(R5) 00001236 * GET COUNT OF BYTES TO ADD 00001237 LR R3,R2 GET TOTAL IN R2, R3 00001238 SR R2,R2 00001239 D R2,=F'3' DIVIDE BY 3 00001240 * R3 = PIECE COUNT 00001241 LTR R2,R2 R2 = EXTRA COUNT 00001242 BZ HAVEXTR DONE IF ZERO 00001243 LA R3,1(R3) ADD ANOTHER PIECE 00001244 HAVEXTR LA R6,0(R4,R6) R6 -> PAST INPUT 00001245 MVC CRCSAVE(5),0(R6) SAVE CRC 00001246 MVI 0(R6),0 APPEND HEX ZEROS 00001247 MVI 1(R6),0 00001248 HEXPLP EQU * LOOP TO EXPAND PIECES 00001249 ICM R7,B'1110',0(R4) GET ALL 24 BITS IN R7 00001250 SR R6,R6 GET FIRST 6 BITS IN R6 00001251 SLDL R6,6 00001252 LA R6,X'20'(R6) CONVERT TO ASCII 00001253 STC R6,0(R5) STORE FIRST RESULT BYTE 00001254 SR R6,R6 REPEAT FOR 2ND BYTE 00001255 SLDL R6,6 00001256 LA R6,X'20'(R6) CONVERT TO ASCII 00001257 STC R6,1(R5) 00001258 SR R6,R6 REPEAT FOR 3RD BYTE 00001259 SLDL R6,6 00001260 LA R6,X'20'(R6) CONVERT TO ASCII 00001261 STC R6,2(R5) 00001262 SR R6,R6 REPEAT FOR 4TH BYTE 00001263 SLDL R6,6 00001264 LA R6,X'20'(R6) CONVERT TO ASCII 00001265 STC R6,3(R5) 00001266 LA R4,3(R4) INCREMENT INPUT POINTER 00001267 LA R5,4(R5) INCREMENT OUTPUT POINTER 00001268 BCT R3,HEXPLP REPEAT FOR PIECE COUNT 00001269 LTR R2,R2 LAST PIECE FULL? 00001270 BZ PACKDONE YES, THEN DONE 00001271 BCTR R5,0 ELIMINATE 4TH BYTE 00001272 C R2,=F'1' REMAINDER ONE? 00001273 BNE PACKDONE NO, KEEP TWO RESULT BYTES 00001274 BCTR R5,0 ELIMINATE 3RD BYTE TOO 00001275 PACKDONE LR R1,R5 R1 = OUTPUT POINTER 00001276 LA R3,CRCSAVE R3 -> CD, CRC 00001277 B WRADDCRC JOIN CRC CODE 00001278 SPACE 00001279 DOQUOTE EQU * CONSTRUCT QUOTED DATA 00001280 LM R1,R2,WRITASAV+4 RESTORE R1, R2 00001281 * R1 -> NEXT OUTPUT BYTE 00001282 S R2,=F'5' R2 = INPUT COUNT 00001283 L R3,=A(GRAFDATA) R3 -> INPUT DATA 00001284 L R4,=A(ABINDATA) R4 -> TRANSLATED DATA 00001285 SR R5,R5 R5, R6 = 0 FOR IC 00001286 SR R6,R6 00001287 LA R7,X'15' R7 = X'15' FOR COMPARISONS 00001288 QUOTELP EQU * QUOTING LOOP 00001289 IC R5,0(R3) R5 = NEW BYTE 00001290 IC R6,0(R4) R6 = TRANSLATED VALUE 00001291 LTR R6,R6 KEEP BYTE? 00001292 BZ QKEEP 00001293 STC R6,0(R1) ELSE STORE R6 00001294 CR R6,R7 CHECK FOR QUOTE VALUE 00001295 BL QNEXT DONE IF NO QUOTE 00001296 LA R1,1(R1) INCREMENT FOR QUOTE 00001297 BE QUOTE15 X'15' QUOTE? 00001298 * ELSE MUST BE X'16': 00001299 S R5,=F'144' CONVERT X'B0' - X'FF' 00001300 B QKEEP AND USE IT 00001301 SPACE 00001302 QUOTE15 C R5,=F'32' CONTROL CHAR.? 00001303 BL QCTL YES, DIFFERENT CONVERSION 00001304 S R5,=F'63' CONVERT X'7F' - X'AF' 00001305 B QKEEP 00001306 SPACE 00001307 QCTL A R5,=F'32' CONVERT X'00' - X'1F' 00001308 QKEEP STC R5,0(R1) USE BYTE AS IS 00001309 QNEXT LA R1,1(R1) 00001310 LA R3,1(R3) INCREMENT POINTERS 00001311 LA R4,1(R4) 00001312 BCT R2,QUOTELP 00001313 WRADDCRC EQU * HANDLE CRC AT END 00001314 MVC 0(5,R1),0(R3) APPEND CRC 00001315 LA R2,5(R1) R2 -> AFTER CRC 00001316 L R3,WRITASAV+4 GET LENGTH IN R2 00001317 LA R3,0(R3) = END ADDRESS - 00001318 SR R2,R3 START ADDRESS 00001319 ST R2,WRITASAV+8 STORE LENGTH TO USE 00001320 TM TRMFLAGS,GRAFTRM 3270 TERMINAL? 00001321 BO WRITAEND YES, KEEP ASCII 00001322 LM R1,R2,WRITASAV+4 GET RESULT REGS. 00001323 S R2,=F'5' DON'T INCLUDE CRC 00001324 L R0,=A(FRASCSTD) R0 = DEFAULT TABLE 00001325 TM FLAGS3,ALTTR IF BROWN, USE SPECIAL TABLE 00001326 BZ QTOEBC 00001327 L R0,=A(FRASCBRN) 00001328 QTOEBC BAL R14,LONGTR TRANSLATE TO EBCDIC 00001329 WRITAEND LM R0,R15,WRITASAV RESTORE REGISTERS 00001330 BR R14 RETURN 00001331 SPACE 00001332 WRITASAV DS 8D LOCAL SAVE AREA 00001333 CRCSAVE DS 6X SAVED CRC 00001334 EJECT 00001335 * 00001336 * "WRITE" OUTPUTS A CHARACTER STRING TO THE TERMINAL. NO EXTRA 00001337 * BYTES (E.G. DC3) ARE TRANSMITTED FOLLOWING THE STRING. 00001338 * AT ENTRY, R1 -> STRING, AND R2 CONTAINS THE STRING LENGTH. 00001339 * 00001340 WRITE DS 0H 00001341 MVI WMODE,0 INDICATE WRITE ONLY 00001342 B WRBOTH 00001343 SPACE 00001344 WRITERD DS 0H 00001345 MVI WMODE,X'FF' INDICATE READ ALSO 00001346 WRBOTH STM R0,R15,WRSAVE SAVE REGISTERS 00001347 TM TRMFLAGS,GRAFTRM 3270 TERMINAL? 00001348 BO WRITEGRF YES, DO 3270 I/O 00001349 LR R3,R1 COPY STRING ADDRESS INTO R3 00001350 * R2 = LENGTH, R3 = ADDRESS OF STRING 00001351 LTR R2,R2 ANY BYTES LEFT? 00001352 BNP WRRTN IF NOT, RETURN 00001353 WRTERM (R3),(R2),EDIT=LONG WRITE (R2) BYTES FROM (R3) 00001354 B WRRTN RETURN 00001355 EJECT 00001356 WRITEGRF EQU * 3270 OUTPUT 00001357 LTR R2,R2 IF NO BYTES, JUST RETURN 00001358 BZ WRRTN 00001359 L R8,=A(GRAFDATA) R8 ADDRESSES GRAFDATA 00001360 USING GRAFDATA,R8 00001361 * STORE XPARENT OR WSF PREFIX 00001362 TM TRMFLAGS,MAC3270 WSF FOR MAC3270 00001363 BO WSFPFX 00001364 MVC GRAFDATA(7),=X'F3115D7F110000' XPARENT WRITE CODE 00001365 LA R3,7 00001366 CLI WMODE,0 JUST WRITE? 00001367 BE ADDPFX YES, HAVE THE RIGHT PREFIX 00001368 MVI GRAFDATA+6,X'01' ELSE CHANGE TO WRITE/READ 00001369 LA R4,0(R1,R2) R4 -> PAST LAST BYTE 00001370 MVC 0(4,R4),=X'0D256E12' SIMULATE LINE MODE PROMPT 00001371 LA R2,4(R2) ADJUST LENGTH 00001372 B ADDPFX 00001373 SPACE 00001374 WSFPFX LA R3,3(R2) GET WSF LENGTH AND STORE 00001375 STCM R3,B'0011',GRAFDATA 00001376 MVI GRAFDATA+2,X'20' APPEND XFER CODE 00001377 LA R3,3 R3 = TOTAL LENGTH 00001378 ADDPFX LA R4,GRAFDATA(R3) R4 -> PAST PREFIX 00001379 LR R6,R1 R6 -> SOURCE DATA 00001380 LR R1,R4 SAVE NEW LOCATION IN R1 00001381 LR R5,R2 R5, R7 = LENGTH 00001382 LR R7,R2 00001383 MVCL R4,R6 COPY DATA TO BUFFER 00001384 * R1 = ADDR., R2 = LENGTH 00001385 L R0,=A(TOASCSTD) R0 -> TRANSLATE TABLE 00001386 TM FLAGS3,ALTTR IF BROWN USE SPECIAL TABLE 00001387 BZ WRBINCK 00001388 L R0,=A(TOASCBRN) 00001389 WRBINCK TM FLAGS2,BINXF BINARY TRANSFER? 00001390 BZ WRITETR NO, NORMAL TRANSLATE 00001391 TM FLAGS2,ASCBIN ASCBIN MODE? 00001392 BO WRABNCK YES, INCLUDE START BYTES 00001393 * APPLETALK BINARY CHECKS: 00001394 LR R4,R1 R4 = COPY OF ADDRESS 00001395 LR R5,R2 R5 = COPY OF LENGTH 00001396 C R5,=F'6' AT LEAST ONE BYTE? 00001397 BL WRITETR NO, NORMAL TRANSLATE 00001398 CLI 0(R4),X'18' COMPRESSED DATA? 00001399 BNE WRGACHK NO, KEEP ADDR., LENGTH 00001400 LA R4,1(R4) R4 -> PAST PREFIX 00001401 BCTR R5,0 R5 = NEW LENGTH 00001402 WRGACHK C R5,=F'7' AT LEAST COMMAND, CHECKSUM? 00001403 BL WRITETR NO, NORMAL TRANSLATE 00001404 CLC 0(2,R4),=X'5742' ASCII WB COMMAND? 00001405 BE WRGWB YES, SPECIAL HANDLING 00001406 CLC 0(2,R4),=X'4D48' ASCII MH COMMAND? 00001407 BNE WRITETR NO, NORMAL TRANSLATE 00001408 WRGWB LR R4,R0 COPY TABLE ADDRESS INTO R4 00001409 LA R5,0(R1,R2) R5 -> PAST LAST BYTE 00001410 S R5,=F'5' R5 -> CHECKSUM DELIMITER 00001411 TR 0(5,R5),0(R4) TRANSLATE CD, CHECKSUM 00001412 B WRTROK CONTINUE WITH I/O 00001413 SPACE 00001414 * SERIAL BINARY CHECKS: 00001415 WRABNCK LR R4,R1 R4 = COPY OF ADDRESS 00001416 LR R5,R2 R5 = COPY OF LENGTH 00001417 C R5,=F'12' AT LEAST ONE DATA BYTE? 00001418 BL WRITETR NO, NORMAL TRANSLATE 00001419 CLI 2(R4),X'17' PACKED DATA? 00001420 BE WRABNOK YES, MUST BE WB OR MH 00001421 CLI 2(R4),X'18' COMPRESSED DATA? 00001422 BNE WRGSCHK NO, KEEP ADDR., LENGTH 00001423 LA R4,1(R4) ADJUST ADDR. AND LENGTH 00001424 BCTR R5,0 TO SKIP PREFIX 00001425 WRGSCHK C R5,=F'13' COMMAND, CRC, PROMPT? 00001426 BL WRITETR NO, NORMAL TRANSLATE 00001427 CLC 2(2,R4),=X'5742' ASCII WB COMMAND? 00001428 BE WRABNOK YES, SPECIAL TRANSLATE 00001429 CLC 2(2,R4),=X'4D48' ASCII MH COMMAND? 00001430 BNE WRITETR NO, NORMAL TRANSLATE 00001431 WRABNOK LR R4,R0 COPY TABLE ADDRESS INTO R4 00001432 LA R5,0(R1,R2) R5 -> PAST LAST BYTE 00001433 S R5,=F'9' R5 -> CHECKSUM DELIMITER 00001434 TR 0(9,R5),0(R4) TRANSLATE CD, CKSUM, PROMPT 00001435 B WRTROK CONTINUE WITH I/O 00001436 SPACE 00001437 WRITETR BAL R14,LONGTR TRANSLATE TO ASCII 00001438 WRTROK TM TRMFLAGS,MAC3270 SKIP NEXT XLATE IF MAC3270 00001439 BO WRDEFCCW 00001440 L R0,=A(HBITTAB) R0 -> TABLE 00001441 BAL R14,LONGTR TURN ON HIGH BIT OF ALL DATA 00001442 WRDEFCCW LA R3,0(R2,R3) R3 = TOTAL LENGTH 00001443 LH R2,CONADDR R2 = CONSOLE ADDRESS 00001444 ICM R2,B'1000',=X'01' INDICATE CMS CONSOLE 00001445 LA R13,R13SAVE R13 -> SAVE AREA 00001446 TM TRMFLAGS,MAC3270 USE WSF FOR MAC3270 00001447 BO WRWSF 00001448 * ELSE 7171 XPARENT WRITE 00001449 STH R3,WCCWLEN STORE DATA SIZE 00001450 LA R1,WCCW R1 -> CCW 00001451 L R15,=V(SCRIO) R15 -> ENTRY POINT 00001452 BALR R14,R15 EXECUTE TRANSPARENT WRITE 00001453 BNZ WRRTN RETURN IF ERROR 00001454 BAL R14,READ3270 WAIT FOR ATTN & ISSUE READ 00001455 CLI WMODE,0 JUST WRITE? 00001456 BE WRRTN YES, THEN RETURN NOW 00001457 B WRREAD PROCESS READ 00001458 SPACE 00001459 WRWSF STH R3,WSFCCWLN STORE LENGTH 00001460 LA R1,WSFCCW3 R1 -> CCW 00001461 L R15,=V(SCRIO) R15 -> ENTRY POINT 00001462 BALR R14,R15 EXECUTE WSF 00001463 BNZ WRRTN RETURN IF ERROR 00001464 CLI WMODE,0 JUST WRITE? 00001465 BE WRRTN YES, THEN RETURN NOW 00001466 BAL R14,READ3270 WAIT FOR ATTN & ISSUE READ 00001467 WRREAD EQU * PROCESS READ 00001468 LA R1,GRAFDATA R1 -> DATA 00001469 LH R2,GRAFLEN R2 = LENGTH 00001470 XC RECVLEN(2),RECVLEN SET LENGTH TO ZERO 00001471 LTR R2,R2 ANY BYTES READ? 00001472 BNP WRRTN NO, JUST RETURN 00001473 TM TRMFLAGS,MAC3270 FOR MAC3270 SKIP AID 00001474 BO SKIPAID 00001475 CLI 0(R1),X'E8' CHECK FOR NULL AID 00001476 BNE WRRTN RETURN IF NOT THERE 00001477 LA R1,3(R1) SKIP 7171 AID AND ADDR. 00001478 S R2,=F'4' ALSO SKIP CR AT END 00001479 B WRRDCOM 00001480 SPACE 00001481 SKIPAID CLI 0(R1),X'88' CHECK FOR WSF REPLY AID 00001482 BNE WRRTN RETURN IF NOT THERE 00001483 LA R1,1(R1) SKIP AID 00001484 BCTR R2,0 ADJUST LENGTH 00001485 WRRDCOM LTR R2,R2 ANY BYTES LEFT 00001486 BNP WRRTN NO, JUST RETURN 00001487 STH R2,RECVLEN STORE LENGTH FOR RECEIVE 00001488 LR R3,R2 R3, R5 = LENGTH 00001489 LR R5,R2 00001490 L R2,=A(RECVDATA) R2 -> DESTINATION 00001491 LR R4,R1 R4 -> SOURCE 00001492 MVCL R2,R4 MOVE DATA 00001493 L R0,=A(FRASCSTD) R0 -> TRANSLATE TABLE 00001494 TM FLAGS3,ALTTR IF BROWN, USE SPECIAL TABLE 00001495 BZ WRITETR2 00001496 L R0,=A(FRASCBRN) 00001497 WRITETR2 L R1,=A(RECVDATA) R1 -> DATA 00001498 LH R2,RECVLEN R2 = LENGTH 00001499 BAL R14,LONGTR TRANSLATE DATA TO EBCDIC 00001500 WRRTN LM R0,R15,WRSAVE RESTORE REGISTERS 00001501 BR R14 RETURN TO CALLER 00001502 SPACE 00001503 WRSAVE DC 8D'0' SAVE AREA FOR R0-R15 00001504 WMODE DS 1X >0 = WRITE, READ FOR 3270 00001505 DROP R8 END GRAFDATA ADDRESSABILITY 00001506 EJECT 00001507 * 00001508 * SUBCHK - CHECK FOR SUBSET MODE 00001509 * IF THE LAST COMMAND RESULTED IN RETURN CODE 11, ENTER SUBSET MODE, 00001510 * OR KEEP THE RETURN CODE AS IS TO ABORT THE TRANSFER. 00001511 * 00001512 SUBCHK DS 0H 00001513 STM R0,R15,SUBSAVE SAVE REGISTERS 00001514 SR R8,R8 R8 = 0 FOR NORMAL RETURN 00001515 L R1,=A(RECVDATA) R1 -> INPUT BUFFER 00001516 CLC 0(6,R1),=C'RC0011' ABORT/SUBSET RETURN CODE? 00001517 BNE SUBRETN IF NOT, CONTINUE NORMALLY 00001518 * RESTORE NORMAL TERMINAL ENVIRONMENT TEMPORARILY 00001519 TM TRMFLAGS,GRAFTRM SKIP ASCII STUFF IF 3270 00001520 BO WSUBCODE 00001521 CLC NODEID(8),BROWNID SKIP PROMPT COMMAND IF NOT BROWN 00001522 BNE PRSKIP2 00001523 LINEDIT TEXT='TERM PROMPT ON',DOT=NO,DISP=CPCOMM 00001524 PRSKIP2 EQU * 00001525 LINEDIT TEXT='TERM LINESIZE 80',DISP=CPCOMM,DOT=NO 00001526 LINEDIT TEXT='SET LINEDIT ON',DISP=CPCOMM,DOT=NO 00001527 DMSEXS MVC,AINTRTBL(4),INTAB RESTORE XLATE TABLES 00001528 DMSEXS MVC,AOUTRTBL(4),OUTTAB 00001529 WSUBCODE LA R1,SUBCODE R1 -> STRING 00001530 LA R2,1 R2 = LENGTH 00001531 BAL R14,WRITE TELL VMXFER TO CALL "SUBSET" 00001532 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00001533 SUBPRMT WRTERM 'Enter ABORT, CONTINUE, or SUBSET',EDIT=NO 00001534 RDTERM RDRESP READ RESPONSE 00001535 CLC RDRESP(7),=CL7'SUBSET' ENTER SUBSET MODE IF WANTED 00001536 BE SUBSET 00001537 CLC RDRESP(6),=CL6'ABORT' ABORT IF WANTED 00001538 BE SUBREST 00001539 CLC RDRESP(9),=CL9'CONTINUE' JUST CONTINUE IF SPECIFIED 00001540 BE SUBCONT 00001541 B SUBPRMT ELSE TRY AGAIN FOR VALID ANSWER 00001542 SPACE 00001543 SUBSET LA R1,SUBCMMD ENTER SUBSET MODE 00001544 SVC 202 "SUBSET" COMMAND 00001545 DC AL4(*+4) 00001546 SUBCONT LA R8,1 INDICATE CP/M COMMAND RETRY 00001547 SPACE 00001548 SUBREST EQU * RESTORE XFER ENVIRONMENT 00001549 BAL R14,BEGINFS RESTORE FULL-SCREEN MODE 00001550 LA R1,SUBCODE R1 -> STRING 00001551 LA R2,1 R2 = LENGTH 00001552 BAL R14,WRITE TELL VMXFER TO RETURN TO MAIN LOOP 00001553 TM TRMFLAGS,GRAFTRM IF 3270, READY TO RETURN 00001554 BO SUBRETN 00001555 MVC INTAB(4),AINTRTBL SAVE "SET INPUT" TABLE 00001556 MVC OUTTAB(4),AOUTRTBL SAVE "SET OUTPUT" TABLE 00001557 DMSEXS XC,AINTRTBL(4),AINTRTBL RESET INPUT TRANSLATION 00001558 DMSEXS XC,AOUTRTBL(4),AOUTRTBL RESET OUTPUT TRANSLATION 00001559 LINEDIT TEXT='SET LINEDIT OFF',DISP=CPCOMM,DOT=NO 00001560 LINEDIT TEXT='TERM LINESIZE OFF',DISP=CPCOMM,DOT=NO 00001561 CLC NODEID(8),BROWNID SET PROMPT IF BROWN 00001562 BNE SUBRETN 00001563 LINEDIT TEXTA=PRMTCMD,DISP=CPCOMM,DOT=NO 00001564 SUBRETN LTR R8,R8 SET CC FOR CPMCMMD 00001565 LM R0,R15,SUBSAVE RESTORE REGISTERS 00001566 BR R14 RETURN TO CPMCMMD 00001567 SPACE 00001568 SUBSAVE DC 8D'0' SAVE AREA R0-R15 00001569 SUBCMMD DC CL8'SUBSET' "SUBSET" COMMAND 00001570 DC 8X'FF' 00001571 SUBCODE DC X'3C' DC4 IS VMXFER SUBSET CODE 00001572 EJECT 00001573 * 00001574 * CALCULATE CP/M SECTOR COUNT FOR FILE 00001575 * 00001576 SIZECALC DS 0H R1 -> FST 00001577 STM R0,R15,SIZESAVE SAVE REGISTERS 00001578 LR R2,R1 ADDRESS FST 00001579 USING FSTD,R2 00001580 CLI FSTRECFM,C'V' FOR RECFM V, HAVE TO READ DATA 00001581 BE VCALC 00001582 TM FLAGS,TEXT LIKEWISE FOR TEXT OPTION 00001583 BO VCALC 00001584 SR R0,R0 R0, R1 = RECORD COUNT 00001585 L R1,FSTAIC 00001586 M R0,FSTLRECL MULTIPLY BY RECORD LENGTH 00001587 B SECTCALC GET SECTORS 00001588 SPACE 00001589 VCALC SR R3,R3 BYTE COUNT = 0 00001590 L R4,INPBUF R4 -> INPUT BUFFER 00001591 MVC FSCBAITN(4),=F'0' SET-UP FSREAD PLIST 00001592 ST R4,FSCBBUFF 00001593 MVC FSCBSIZE(4),FSTLRECL 00001594 MVC FSCBANIT(4),=F'1' 00001595 OI FLAGS,BLNKLINE TREAT AS LAST LINE BLANK 00001596 VCALCLP EQU * 00001597 FSREAD FSCB=INFILE,FORM=E CALL FSREAD 00001598 LTR R15,R15 STOP AT FIRST ERROR 00001599 BNZ VCEND 00001600 TM FLAGS2,BINXF BINARY TRANSFER? 00001601 BO VCKEEP YES, ALWAYS USE ACTUAL LENGTH 00001602 TM FLAGS,TEXT EXTRA WORK IF TEXT OPTION 00001603 BO TXTCALC 00001604 VCKEEP AL R3,FSCBNORD INCREMENT BYTE COUNT 00001605 B VCALCLP GET NEXT LINE 00001606 SPACE 00001607 TXTCALC L R5,FSCBNORD ADJUST LENGTH TO DELETE TRAILING 00001608 * BLANKS 00001609 TXTCLP EQU * LOOP TO FIND LAST NON-BLANK 00001610 LA R6,0(R4,R5) POINT TO NEXT BYTE FROM RIGHT 00001611 BCTR R6,0 00001612 CLI 0(R6),C' ' USE LENGTH IN R5 IF NON-BLANK 00001613 BNE TXTCADD 00001614 BCT R5,TXTCLP REPEAT 00001615 LA R5,1 LENGTH FOR CR IS 1 00001616 CLI VERSDATA,C'C' CP/M SYSTEM? 00001617 BNE KEEPCRC NO, CONTINUE 00001618 LA R5,2 ELSE INCLUDE LF 00001619 KEEPCRC TM FLAGS,TRUNCATE TRUNCATE OPTION? 00001620 BO TXTCLOK YES, SKIP BLNKLINE TEST 00001621 TM FLAGS,BLNKLINE WAS LAST LINE BLANK? 00001622 BO TXTCLOK IF SO, KEEP 1 CR 00001623 LA R5,2 00001624 CLI VERSDATA,C'C' CP/M SYSTEM? 00001625 BNE TXTCLOK NO, CONTINUE 00001626 LA R5,4 ELSE INCLUDE LF 00001627 TXTCLOK OI FLAGS,BLNKLINE REMEMBER HAD BLANK LINE 00001628 B TXTCLNOK DONE WITH LINE 00001629 SPACE 00001630 TXTCADD NI FLAGS,255-BLNKLINE REMEMBER LINE NOT BLANK 00001631 LA R5,1(R5) ACCOUNT FOR BLANK OR LF AT END 00001632 TM FLAGS,TRUNCATE TRUNCATE OPTION? 00001633 BZ TXTCLNOK NO, ALL SET 00001634 CLI VERSDATA,C'C' CP/M SYSTEM? 00001635 BNE TXTCLNOK NO, ALL SET 00001636 LA R5,1(R5) ALSO INCLUDE CR 00001637 TXTCLNOK ALR R3,R5 00001638 B VCALCLP GET NEXT LINE 00001639 SPACE 1 00001640 VCEND FSCLOSE FSCB=INFILE CLOSE FILE 00001641 LR R1,R3 COPY BYTE COUNT 00001642 TM FLAGS,TEXT ALREADY HAVE FINAL COUNT IF TEXT 00001643 BO SECTRND 00001644 SECTCALC TM FLAGS2,BINXF BINARY TRANSFER? 00001645 BO SECTRND YES, NO EXTRA CHARACTERS ADDED 00001646 AL R1,FSTAIC ACCOUNT FOR CR AT END 00001647 CLI VERSDATA,C'C' CP/M SYSTEM? 00001648 BNE SECTRND NO, CONTINUE 00001649 AL R1,FSTAIC ELSE ALSO INCLUDE LINEFEED 00001650 SECTRND TM FLAGS2,BINXF BINARY TRANSFER? 00001651 BO SECTDIV YES, USE COUNT AS IS 00001652 LA R1,1(R1) ELSE ADD 1 FOR CP/M EOF 00001653 SECTDIV ST R1,TOTSIZE SAVE FINAL SIZE 00001654 TM FLAGS2,MACBIN MACBINARY TRANSFER? 00001655 BZ SECTNBIN NO, CONTINUE 00001656 S R1,=F'128' SUBTRACT SIZE OF HEADER 00001657 SECTNBIN LA R1,127(R1) GET NO. OF 128-BYTE SECTORS 00001658 SRL R1,7 00001659 STCM R1,B'0011',SIZEDATA GET RESULT AS HEX CHARS 00001660 UNPK SIZECHAR(5),SIZEDATA(3) 00001661 TR SIZECHAR(4),HEXCHARS-240 00001662 LM R0,R15,SIZESAVE RESTORE REGISTERS 00001663 BR R14 RETURN TO CALLER 00001664 SPACE 00001665 SIZESAVE DS 16F LOCAL SAVE AREA 00001666 TOTSIZE DS 1F TOTAL SIZE BEFORE DIVISION 00001667 SIZEDATA DS 2X BUFFERS FOR CONVERSION 00001668 DS 1X 00001669 SIZECHAR DS 5X 00001670 DROP R2 DONE WITH FST 00001671 EJECT 00001672 * 00001673 * GET MAC DATE AND TIME FROM CMS FILE DATE AND TIME 00001674 * 00001675 MACDATE DS 0H R1 -> FST 00001676 STM R0,R15,DATESAVE SAVE REGISTERS 00001677 LR R2,R1 ADDRESS FST 00001678 USING FSTD,R2 00001679 MVC DATECHAR(2),=C'19' 00001680 UNPK DATECHAR+2(15),FSTADATI(8) 00001681 LM R0,R15,DATESAVE RESTORE REGISTERS 00001682 BR R14 RETURN TO CALLER 00001683 SPACE 00001684 DATESAVE DS 8D REGISTER SAVE AREA 00001685 DATECHAR DS 17X MAC DATE AS DEC CHARS. 00001686 DROP R2 DONE WITH FST 00001687 SPACE 1 00001688 * 00001689 * CALCULATE CP/M DATE AND TIME FROM CMS FILE DATE AND TIME 00001690 * 00001691 CPMDATE DS 0H R1 -> FST 00001692 STM R0,R15,DATESAVE SAVE REGISTERS 00001693 LR R2,R1 ADDRESS FST 00001694 USING FSTD,R2 00001695 MVC DATEBIN+2(2),FSTADATI+3 HOURS, MINUTES 00001696 SR R1,R1 GET BINARY YEAR 00001697 IC R1,FSTADATI 00001698 LR R3,R1 R3 = ONES 00001699 N R3,=X'0000000F' 00001700 SRL R1,4 R1 = TENS 00001701 MH R1,=H'10' 00001702 AR R1,R3 ADD ONES 00001703 STH R1,YEAR STORE RESULT 00001704 SR R1,R1 GET BINARY MONTH 00001705 IC R1,FSTADATI+1 00001706 LR R3,R1 R3 = ONES 00001707 N R3,=X'0000000F' 00001708 SRL R1,4 R1 = TENS 00001709 MH R1,=H'10' 00001710 AR R1,R3 ADD ONES 00001711 STH R1,MONTH STORE RESULT 00001712 SR R1,R1 GET BINARY DAY 00001713 IC R1,FSTADATI+2 00001714 LR R3,R1 R3 = ONES 00001715 N R3,=X'0000000F' 00001716 SRL R1,4 R1 = TENS 00001717 MH R1,=H'10' 00001718 AR R1,R3 ADD ONES 00001719 STH R1,DAY STORE RESULT 00001720 * CALCULATE JULIAN DATE 00001721 LH R5,YEAR GET THE YEAR 00001722 LH R7,MONTH AND THE MONTH 00001723 S R7,=F'3' CHECK FOR JAN., FEB. 00001724 BNM CTOJ1 00001725 LA R7,12(R7) ADD 12 TO MONTH 00001726 BCTR R5,0 DECREMENT YEAR 00001727 CTOJ1 SR R4,R4 R4,R5 = (YEAR * 1461) / 4 00001728 M R4,=F'1461' 00001729 D R4,=F'4' 00001730 SR R6,R6 R6,R7 = (153 * MONTH + 2) / 5 00001731 M R6,=F'153' 00001732 LA R7,2(R7) 00001733 D R6,=F'5' 00001734 AR R5,R7 ADD QUOTIENTS 00001735 AH R5,DAY ADD DAY 00001736 S R5,=F'28430' SUBTRACT 1 AND CP/M ADJUSTMENT 00001737 BNM USEJD USE 0 IF NEGATIVE 00001738 SR R5,R5 00001739 USEJD STH R5,DATEBIN STORE IN BINARY RESULT 00001740 UNPK DATECHAR(9),DATEBIN(5) CONVERT TO HEX CHARACTERS 00001741 TR DATECHAR(8),HEXCHARS-240 00001742 LM R0,R15,DATESAVE RESTORE REGISTERS 00001743 BR R14 RETURN TO CALLER 00001744 SPACE 00001745 DATEBIN DS 1F CP/M DATE 00001746 YEAR DS 1H BINARY YEAR 00001747 MONTH DS 1H BINARY MONTH 00001748 DAY DS 1H BINARY DAY 00001749 DROP R2 DONE WITH FST 00001750 SPACE 1 00001751 * 00001752 * SUBROUTINE TO UPDATE TRANSFER RATE FROM LAST COMMAND TIMING 00001753 * 00001754 TIMEUPD DS 0H 00001755 STM R0,R15,TIMESAVE SAVE REGISTERS 00001756 L R1,WRCNT GET TOTAL CHARACTER COUNT 00001757 A R1,RDCNT 00001758 C R1,=F'160' IGNORE IF < 160 00001759 BL TIMERTN 00001760 A R1,TOTCHRS UPDATE TOTAL CHARACTERS 00001761 ST R1,TOTCHRS 00001762 LM R2,R3,ENDTIME GET ELAPSED TIME 00001763 SRDL R2,12 SHIFT TO GET MICROSECONDS 00001764 LM R4,R5,STRTTIME 00001765 SRDL R4,12 00001766 SLR R3,R5 GET LOW-ORDER DIFFERENCE 00001767 BNM MSSUB IF NO BORROW, READY FOR REST 00001768 SL R2,=F'1' PERFORM BORROW 00001769 MSSUB SLR R2,R4 GET HIGH-ORDER DIFFERENCE 00001770 LM R4,R5,TOTSECS GET PREVIOUS TOTAL 00001771 ALR R3,R5 GET LOW-ORDER SUM 00001772 BC 12,MSADD IF NO CARRY, READY FOR REST 00001773 AL R2,=F'1' PERFORM CARRY 00001774 MSADD ALR R2,R4 GET HIGH-ORDER RUM 00001775 STM R2,R3,TOTSECS STORE NEW TOTAL 00001776 D R2,=F'1000000' DIVIDE BY 1000000 TO GET SECONDS 00001777 C R2,=F'500000' IS REMAINDER MORE THAN HALF? 00001778 BNH USESECS NO, KEEP QUOTIENT 00001779 AL R3,=F'1' ELSE ADD 1 00001780 USESECS LTR R3,R3 ZERO SECONDS? 00001781 BZ TIMERTN YES, JUST RETURN 00001782 SR R0,R0 R0,R1 = TOTAL CHARACTERS 00001783 DR R0,R3 DIVIDE TO GET CHARS./SECOND IN R1 00001784 SRL R3,1 R3 = HALF OF SECONDS 00001785 CR R0,R3 IS REMAINDER MORE THAN HALF? 00001786 BNH USERATE NO, KEEP QUOTIENT 00001787 AL R1,=F'1' ELSE ADD 1 00001788 USERATE CVD R1,DECBUF CONVERT TO PACKED DECIMAL 00001789 UNPK DECBUF(5),DECBUF+5(3) CONVERT TO CHARS. 00001790 OI DECBUF+4,X'F0' FIX FIRST NIBBLE OF LAST BYTE 00001791 MVC XFSPEED(4),DECBUF+1 UPDATE XFSPEED WITH RESULT 00001792 TIMERTN LM R0,R15,TIMESAVE RESTORE REGISTERS 00001793 BR R14 RETURN 00001794 SPACE 00001795 TIMESAVE DS 8D LOCAL SAVE AREA 00001796 EJECT 00001797 * 00001798 * TERMTYPE - subroutine to determine terminal information and 00001799 * set TRMFLAGS accordingly. The 3270 console address 00001800 * is also determined and saved. 00001801 * 00001802 TERMTYPE DS 0H 00001803 STM R0,R15,TRMSAVE SAVE REGISTERS 00001804 L R4,=F'-1' GET CONSOLE ADDR. FROM CP 00001805 DIAG R4,R5,X'24' GET CONSOLE CHARACTERISTICS 00001806 BNZ TRMDONE IF ANY ERROR, TREAT AS ASCII 00001807 STCM R4,B'0011',CONADDR SAVE CONSOLE ADDRESS 00001808 LA R4,GRTSIZE GET GRAFTAB SIZE 00001809 LA R5,GRAFTAB R5 -> START OF TABLE 00001810 GRTLOOP EQU * CHECK FOR REAL 3270 00001811 CLM R6,B'1100',0(R5) CHECK REAL CLASS & TYPE 00001812 BE TRM3270 HAVE A 3270 IF MATCH 00001813 LA R5,4(R5) R5 -> NEXT ENTRY 00001814 BCT R4,GRTLOOP LOOP THROUGH TABLE 00001815 B TRMDONE TREAT AS ASCII IF NO MATCH 00001816 SPACE 00001817 TRM3270 EQU * NOW CHECK MODEL NUMBER 00001818 TM 3(R5),WSF MIGHT WSF BE SUPPORTED? 00001819 BZ MDLINIT NO, SKIP TO MODEL TEST 00001820 OI TRMFLAGS,SFDEV INDICATE WSF MAY WORK 00001821 MDLINIT LA R4,MDLSIZE GET MDLTAB SIZE 00001822 LA R5,MDLTAB R5 -> START OF TABLE 00001823 MDLLOOP EQU * SCAN FOR MATCHING MODEL 00001824 CLM R6,B'0010',0(R5) COMPARE MODELS 00001825 BE USE3270 READY TO USE IF A MATCH 00001826 LA R5,3(R5) R5 -> NEXT ENTRY 00001827 BCT R4,MDLLOOP LOOP THROUGH TABLE 00001828 MVI TRMFLAGS,0 TREAT AS ASCII IF NO MATCH 00001829 B TRMDONE 00001830 SPACE 1 00001831 USE3270 OI TRMFLAGS,GRAFTRM INDICATE 3270 TERMINAL 00001832 * CHECK FOR VTAM CONNECTION 00001833 LA R1,MSGOFF R1 -> TERM BREAKIN COMMAND 00001834 LA R3,MSGOFFLB R3 = COMMAND LENGTH 00001835 ICM R3,B'1000',=X'40' INDICATE RESPONSE IN A BUFFER 00001836 L R2,=A(RECVDATA) R2 -> BUFFER 00001837 LA R4,128 R4 = BUFFER LENGTH 00001838 DIAG R1,R3,8 EXECUTE COMMAND 00001839 LTR R3,R3 DID IT WORK? 00001840 BZ NOTVTAM YES, MUST NOT BE VTAM 00001841 OI TRMFLAGS,VTAM SET VTAM FLAG 00001842 B VTAMEND 00001843 SPACE 00001844 NOTVTAM LA R1,MSGON RESTORE BREAKIN DEFAULT 00001845 LA R3,MSGONLB 00001846 DIAG R1,R3,8 00001847 VTAMEND BAL R14,BEGINFS ENTER FULL-SCREEN MODE 00001848 TM TRMFLAGS,SFDEV ANY POINT IN ISSUING WSF? 00001849 BZ TRMDONE NO, JUST RETURN 00001850 TRYWSF1 LA R1,WSFCCW1 R1 -> WSF CCW 00001851 LH R2,CONADDR R2 = CONSOLE ADDRESS 00001852 ICM R2,B'1000',=X'01' INDICATE CMS CONSOLE 00001853 LA R13,R13SAVE R13 -> SAVE AREA 00001854 L R15,=V(SCRIO) R15 -> ENTRY POINT 00001855 BALR R14,R15 EXECUTE WSF QUERY REPLY 00001856 BZ WSFREAD IF OK, READ AND INTERPRET 00001857 C R15,=X'0000008E' LINE-MODE INPUT WAITING? 00001858 BNE TRMDONE NO, MUST NOT BE SUPPORTED 00001859 L R2,=A(RECVDATA) R2 -> BUFFER 00001860 RDTERM (R2) READ LINE MODE INPUT 00001861 B TRYWSF1 TRY AGAIN 00001862 SPACE 00001863 WSFREAD BAL R14,READ3270 READ RESPONSE INTO GRAFDATA 00001864 L R8,=A(GRAFDATA) R8 ADDRESSES GRAFDATA 00001865 USING GRAFDATA,R8 00001866 LA R2,GRAFDATA R2 -> START OF DATA 00001867 LH R3,GRAFLEN R3 = LENGTH OF DATA 00001868 C R3,=F'3' AT LEAST AID AND LENGTH? 00001869 BL TRMDONE IF NOT, NOTHING TO DO (STRANGE) 00001870 CLI 0(R2),X'88' CORRECT AID BYTE? 00001871 BNE TRMDONE NO, ALSO STRANGE 00001872 LA R2,1(R2) R2 -> FIRST FIELD 00001873 BCTR R3,0 R3 = BYTES REMAINING 00001874 * LOOP TO PROCESS FIELDS 00001875 QRNEWFLD EQU * START NEW FIELD 00001876 C R3,=F'4' AT LEAST 4 BYTES LEFT? 00001877 BL TRMDONE NO, MUST BE DONE 00001878 CLI 2(R2),X'81' QUERY REPLY ID? 00001879 BNE TRMDONE NO, CAN'T DEAL WITH THIS 00001880 SR R4,R4 GET FIELD LENGTH IN R4 00001881 ICM R4,B'0011',0(R2) 00001882 CR R3,R4 EXIT IF NOT THAT MUCH LEFT 00001883 BL TRMDONE (SHOULDN'T HAPPEN) 00001884 CLI 3(R2),X'80' SUMMARY CODE? 00001885 BNE QRNXTFLD NO, TRY NEXT FIELD 00001886 LA R5,4(R2) R5 -> FIRST SUMMARY CODE 00001887 LR R6,R3 R6 = COUNT OF CODES 00001888 S R6,=F'4' 00001889 BNP TRMDONE DONE IF NOT > 0 00001890 QRPQLP EQU * LOOK FOR RQPNAMES CODE 00001891 CLI 0(R5),X'A1' FOUND THE CODE 00001892 BE FOUNDRPQ YES, PROCESS 00001893 LA R5,1(R5) R5 -> NEXT CODE 00001894 BCT R6,QRPQLP TRY NEXT 00001895 B TRMDONE EXIT IF NOT FOUND 00001896 SPACE 00001897 QRNXTFLD AR R2,R4 INCREMENT POINTER 00001898 SR R3,R4 DECREMENT BYTES LEFT 00001899 B QRNEWFLD REPEAT TO END OF DATA 00001900 SPACE 00001901 FOUNDRPQ EQU * RETRIEVE RPQ NAMES DATA 00001902 TRYWSF2 LA R1,WSFCCW2 R1 -> WSF CCW 00001903 LH R2,CONADDR R2 = CONSOLE ADDRESS 00001904 ICM R2,B'1000',=X'01' INDICATE CMS CONSOLE 00001905 LA R13,R13SAVE R13 -> SAVE AREA 00001906 L R15,=V(SCRIO) R15 -> ENTRY POINT 00001907 BALR R14,R15 EXECUTE WSF QUERY REPLY 00001908 BZ RPQREAD IF OK, READ AND INTERPRET 00001909 C R15,=X'0000008E' LINE-MODE INPUT WAITING? 00001910 BNE TRMDONE NO, MUST NOT BE SUPPORTED 00001911 L R2,=A(RECVDATA) R2 -> INPUT BUFFER 00001912 RDTERM (R2) READ LINE MODE INPUT 00001913 B TRYWSF2 TRY AGAIN 00001914 SPACE 00001915 RPQREAD BAL R14,READ3270 READ RESPONSE INTO GRAFDATA 00001916 LH R2,GRAFLEN GET SIZE OF RESPONSE 00001917 C R2,=F'19' AT LEAST 19 BYTES? 00001918 BL TRMDONE NO, CAN'T USE 00001919 CLI GRAFDATA,X'88' QUERY REPLY AID? 00001920 BNE TRMDONE NO, CAN'T USE 00001921 CLC GRAFDATA+3(2),=X'81A1' CORRECT REPLY? 00001922 BNE TRMDONE NO, CAN'T USE 00001923 CLC GRAFDATA+5(4),=C'GFTM' CORRECT DEVICE? 00001924 BNE TRMDONE NO, CAN'T USE 00001925 OI TRMFLAGS,MAC3270 SET MAC3270 FLAG 00001926 MVI M3270VER,C'A' 'A' FOR APPLETALK 00001927 MVC M3270VER+1(2),GRAFDATA+14 COPY VERSION 00001928 MVC M3270VER+3(2),GRAFDATA+17 00001929 TRMDONE LM R0,R15,TRMSAVE RESTORE REGISTERS 00001930 BR R14 RETURN 00001931 TRMSAVE DS 8D LOCAL SAVE AREA 00001932 DROP R8 DONE ADDRESSING GRAFDATA 00001933 SPACE 00001934 * 3270 LIST OF RDEVTYPC, RDEVTYPE, ERASE/WRITE OR ERASE/WRITE ALT. BITS 00001935 * AND MASK FOR APL/TEXT SUPPORT 00001936 GRAFTAB EQU * 00001937 DC AL1(CLASGRAF,TYP3277),X'80',AL1(0) LOCAL 3277 00001938 DC AL1(CLASGRAF,TYP3278),X'C0',AL1(WSF) LOCAL 3278,3279 00001939 DC AL1(CLASGRAF,TYP3276),X'C0',AL1(0) LOCAL 3276 00001940 DC AL1(CLASGRAF,TYP3275),X'80',AL1(0) LOCAL 3275 00001941 DC AL1(CLASTERM,TYP3277),X'80',AL1(0) REMOTE 3277 00001942 DC AL1(CLASTERM,TYP3278),X'C0',AL1(WSF) REMOTE 3278,3279 00001943 DC AL1(CLASTERM,TYP3276),X'C0',AL1(0) REMOTE 3276 00001944 DC AL1(CLASTERM,TYP3275),X'80',AL1(0) REMOTE 3275 00001945 GRTSIZE EQU (*-GRAFTAB)/4 NUMBER OF TABLE ENTRIES 00001946 SPACE 00001947 CLASTERM EQU X'80' TERMINAL DEVICE CLASS 00001948 CLASGRAF EQU X'40' GRAPHICS DEVICE CLASS 00001949 TYP3277 EQU X'04' 3277 DISPLAY STATION 00001950 TYP3276 EQU X'03' 3276 DISPLAY STATION 00001951 TYP3275 EQU X'02' 3275 DISPLAY STATION 00001952 TYP3278 EQU X'01' 3278 DISPLAY STATION 00001953 TYP3215 EQU X'00' 3215 CONSOLE 00001954 SPACE 00001955 WSF EQU X'01' WSF IS POTENTIALLY SUPPORTED 00001956 SPACE 00001957 * TABLE OF MODEL NUMBER BYTE , ROW COUNT, AND SCREEN WIDTH 00001958 MDLTAB EQU * 00001959 DC X'02',AL1(24),AL1(80) 24 ROWS, 80 COLUMNS 00001960 DC X'2A',AL1(20),AL1(80) 20 ROWS, 80 COLUMNS 00001961 DC X'03',AL1(32),AL1(80) 32 ROWS, 80 COLUMNS 00001962 DC X'04',AL1(43),AL1(80) 43 ROWS, 80 COLUMNS 00001963 DC X'05',AL1(27),AL1(132) 27 ROWS, 132 COLUMNS 00001964 DC X'01',AL1(12),AL1(80) 12 ROWS, 80 COLUMNS 00001965 MDLSIZE EQU (*-MDLTAB)/3 NUMBER OF TABLE ENTRIES 00001966 EJECT 00001967 * 00001968 * BEGINFS and ENDFS: subroutines to enter and leave 3270 00001969 * full-screen mode 00001970 DS 0H 00001971 BEGINFS EQU * 00001972 TM TRMFLAGS,GRAFTRM 3270 TERMINAL? 00001973 BZR R14 NO, JUST IGNORE 00001974 TM FLAGS,FS3270 ALREADY IN FULL-SCREEN MODE? 00001975 BOR R14 YES, JUST RETURN 00001976 STM R0,R15,FSSAVE SAVE REGISTERS 00001977 LA R1,MSGOFF R1 -> CP COMMANDS 00001978 LA R2,MSGOFFL R2 = LENGTH 00001979 TM TRMFLAGS,VTAM VTAM CONNECTION? 00001980 BZ OFFDIAG NO, CONTINUE 00001981 LA R1,MSGOFFV R1 -> VTAM CP COMMANDS 00001982 LA R2,MSGOFFVL R2 = LENGTH 00001983 OFFDIAG DIAG R1,R2,8 EXECUTE COMMANDS TO SUPPRESS MSGS. 00001984 LA R1,CANCLCCW R1 -> CANCEL CCW 00001985 LH R2,CONADDR R2 = CONSOLE ADDRESS 00001986 ICM R2,B'1000',=X'01' INDICATE CMS CONSOLE 00001987 LA R13,R13SAVE R13 -> SAVE AREA 00001988 L R15,=V(SCRIO) R15 -> ENTRY POINT 00001989 BALR R14,R15 EXECUTE CANCEL CCW 00001990 * NOTE: INTERRUPTS ARE NOW DISABLED 00001991 L R1,=A(GRAFDATA) 00001992 MVC 0(4,R1),=X'F3114040' WRITE WCC, SBA 00001993 MVC WCCWLEN(2),=H'4' LENGTH (OF WCC) = 1 00001994 LA R1,WCCW R1 -> CCW 00001995 L R15,=V(SCRIO) R15 -> ENTRY POINT 00001996 BALR R14,R15 ERASE/WRITE FOR FULL-SCREEN MODE 00001997 OI FLAGS,FS3270 REMEMBER IN FULL-SCREEN MODE 00001998 LM R0,R15,FSSAVE RESTORE REGISTERS 00001999 BR R14 RETURN TO CALLER 00002000 SPACE 00002001 ENDFS EQU * END FULL-SCREEN MODE 00002002 TM FLAGS,FS3270 IN FULL-SCREEN MODE? 00002003 BZR R14 NO, JUST RETURN 00002004 STM R0,R15,FSSAVE SAVE REGISTERS 00002005 LH R2,CONADDR R2 = CONSOLE ADDRESS 00002006 ICM R2,B'1000',=X'01' INDICATE CMS CONSOLE 00002007 LA R13,R13SAVE R13 -> SAVE AREA 00002008 L R1,=A(GRAFDATA) 00002009 MVC 0(4,R1),=X'F1114040' WRITE CCW, SBA 00002010 MVC WCCWLEN(2),=H'4' LENGTH (OF WCC) = 1 00002011 LA R1,WCCW R1 -> CCW 00002012 L R15,=V(SCRIO) R15 -> ENTRY POINT 00002013 BALR R14,R15 CLEAR SCREEN, LOCK KEYBOARD 00002014 SSM =X'FF' RESTORE INTERRUPTS 00002015 LA R1,MSGON R1 -> CP COMMANDS 00002016 LA R2,MSGONL R2 = LENGTH 00002017 TM TRMFLAGS,VTAM VTAM CONNECTION? 00002018 BZ ONDIAG NO, CONTINUE 00002019 LA R1,MSGONV R1 -> VTAM CP COMMANDS 00002020 LA R2,MSGONVL R2 = LENGTH 00002021 ONDIAG DIAG R1,R2,8 EXECUTE COMMANDS TO ALLOW MSGS. 00002022 NI FLAGS,255-FS3270 REMEMBER NOT IN FULL-SCREEN MODE 00002023 LM R0,R15,FSSAVE RESTORE REGISTERS 00002024 BR R14 RETURN TO CALLER 00002025 SPACE 00002026 FSSAVE DS 8D LOCAL SAVE AREA 00002027 R13SAVE DS 12D STANDARD SAVE AREA FOR SCRIO 00002028 CANCLCCW DC X'1900000020FF0001' DISPW CANCEL CCW 00002029 MSGOFF DC C'TERM BREAKIN GUESTCTL' CP COMMANDS FOR NO MESSAGES 00002030 MSGOFFLB EQU *-MSGOFF LENGTH OF TERM BREAKIN COMMAND 00002031 DC X'15' 00002032 DC C'SET WNG OFF' 00002033 DC X'15' 00002034 DC C'SET ACNT OFF' 00002035 MSGOFFL EQU *-MSGOFF 00002036 MSGON DC C'TERM BREAKIN IMMED' CP COMMANDS TO RESTORE MESSAGES 00002037 MSGONLB EQU *-MSGON LENGTH OF TERM BREAKIN COMMAND 00002038 DC X'15' 00002039 DC C'SET WNG ON' 00002040 DC X'15' 00002041 DC C'SET ACNT ON' 00002042 MSGONL EQU *-MSGON 00002043 MSGOFFV DC C'SET MSG OFF' VTAM CP COMMANDS FOR NO MESSAGES 00002044 DC X'15' 00002045 DC C'SET WNG OFF' 00002046 DC X'15' 00002047 DC C'SET ACNT OFF' 00002048 MSGOFFVL EQU *-MSGOFFV 00002049 MSGONV DC C'SET MSG ON' VTAM CP COMMANDS TO RESTORE MESSAGES 00002050 DC X'15' 00002051 DC C'SET WNG ON' 00002052 DC X'15' 00002053 DC C'SET ACNT ON' 00002054 MSGONVL EQU *-MSGONV 00002055 EJECT 00002056 * 00002057 * READ3270: Wait for attention from console and issue read-modified 00002058 * 00002059 READ3270 DS 0H 00002060 STM R0,R15,RDMSAVE SAVE REGISTERS 00002061 DMSKEY NUCLEUS NEED SYSTEM KEY FOR PSWS 00002062 RDWAIT EQU * DO READ-MODIFIED AFTER ATTN 00002063 MVC SAVEPSW(8),IONPSW SAVE CURRENT I/O NEW PSW 00002064 LA R1,FINWAIT STORE NEW INTERRUPT ADDRESS 00002065 ST R1,IONPSW+4 00002066 MVC SAVEEXT(8),EXTNPSW ALSO SAVE EXTERNAL NEW PSW 00002067 LA R1,EXTINT STORE NEW EXT. INT. ADDRESS 00002068 ST R1,EXTNPSW+4 00002069 LPSW EQU * 00002070 LPSW WAIT < < < W A I T > > > 00002071 EXTINT EQU * 00002072 MVC IONPSW(8),SAVEPSW RESTORE PSWS 00002073 MVC EXTNPSW(8),SAVEEXT 00002074 LA R1,RDWAIT TELL CMS WHERE TO GO BACK 00002075 ST R1,EXTOPSW+4 00002076 NI EXTOPSW+1,255-2 RESET WAIT BIT 00002077 NI EXTOPSW,0 DON'T RE-ENABLE INTERRUPTS YET 00002078 LPSW SAVEEXT PASS INTERRUPT TO CMS 00002079 SPACE 00002080 FINWAIT EQU * 00002081 MVC IONPSW(8),SAVEPSW RESTORE PSWS 00002082 MVC EXTNPSW(8),SAVEEXT 00002083 CLC IOOPSW+2(2),CONADDR IS IT THE VIRTUAL CONSOLE? 00002084 BE CHKATTN YES, CHECK FOR ATTENTION 00002085 CMSINT EQU * HAVE CMS HANDLE INTERRUPT 00002086 LA R1,RDWAIT TELL CMS WHERE TO GO BACK 00002087 ST R1,IOOPSW+4 00002088 NI IOOPSW+1,255-2 RESET WAIT BIT 00002089 NI IOOPSW,0 DON'T RE-ENABLE INTERRUPTS YET 00002090 LPSW SAVEPSW PASS INTERRUPT TO CMS 00002091 SPACE 00002092 CHKATTN TM CSW+4,X'80' IS THIS ATTN? 00002093 BZ CMSINT NO, PASS IT TO CMS 00002094 LA R1,RCCW R1 -> READ-MODIFIED CCW 00002095 LH R2,CONADDR R2 = CONSOLE ADDRESS 00002096 ICM R2,B'1000',=X'01' INDICATE CMS CONSOLE 00002097 LA R13,R13SAVE R13 -> SAVE AREA 00002098 L R15,=V(SCRIO) R15 -> ENTRY POINT 00002099 BALR R14,R15 DO FULL-SCREEN READ 00002100 BNZ RDERR CHECK FOR ANY ERROR 00002101 L R1,=F'4096' BYTES READ = BUFFER LENGTH 00002102 SR R1,R0 - RESIDUAL COUNT 00002103 STH R1,GRAFLEN STORE READ LENGTH 00002104 B RDMRTN READY TO RETURN 00002105 SPACE 00002106 RDERR SR R1,R1 FOR ERROR, RETURN SIZE 0 00002107 STH R1,GRAFLEN 00002108 RDMRTN DMSKEY RESET RESTORE USER KEY 00002109 LM R0,R15,RDMSAVE RESTORE REGISTERS 00002110 BR R14 RETURN TO CALLER 00002111 SPACE 00002112 RDMSAVE DS 8D LOCAL SAVE AREA 00002113 SAVEPSW DS 1D SAVED PSWS 00002114 SAVEEXT DS 1D 00002115 WAIT DC X'FF060000',AL4(LPSW) WAIT STATE PSW 00002116 EJECT 00002117 * 00002118 * LONGTR - execute TR for arbitrary length string 00002119 * R0 -> table, R1 -> string, R2 = length 00002120 * 00002121 LONGTR DS 0H 00002122 STM R0,R5,TRSAVE SAVE REGISTERS 00002123 LR R4,R0 R4 -> TRANSLATE TABLE 00002124 LR R3,R2 R3 = BYTES LEFT 00002125 SRL R3,8 SHIFT TO GET BCT COUNT 00002126 LTR R3,R3 IF ZERO, SKIP LOOP 00002127 BZ TREND 00002128 LTRLOOP EQU * LOOP FOR 256-BYTE PIECES 00002129 TR 0(256,R1),0(R4) DO THIS PIECES 00002130 LA R1,256(R1) INCREMENT ADDRESS 00002131 S R2,=F'256' DECREMENT LENGTH 00002132 BCT R3,LTRLOOP 00002133 TREND LTR R2,R2 RETURN IF NO BYTES LEFT 00002134 BZ TRRTN 00002135 BCTR R2,0 DECREMENT FOR EXECUTE 00002136 EX R2,TRINST 00002137 TRRTN LM R0,R5,TRSAVE RESTORE REGISTERS 00002138 BR R14 RETURN 00002139 SPACE 00002140 TRSAVE DS 3D LOCAL REGISTER SAVE AREA 00002141 TRINST TR 0(*-*,R1),0(R4) INSTRUCTION FOR EX 00002142 EJECT 00002143 * 00002144 * GETID - Invoke IDENTIFY to get the local node id. Set the 00002145 * node id to blanks if any error. 00002146 * 00002147 SPACE 00002148 GETID DS 0H 00002149 STM R14,R1,GETSAVE SAVE REGISTERS 00002150 MVC NODEID(8),=CL8' ' INITIALIZE NODE ID TO BLANKS 00002151 LA R1,IDPLIST EXECUTE IDENTIFY 00002152 SVC 202 00002153 DC AL4(1) 00002154 LTR R15,R15 JUST RETURN IF ANY ERRORS 00002155 BNZ GETIDRTN 00002156 RDTERM RDRESP GET RESPONSE 00002157 C R0,=F'19' AT LEAST 19 BYTES? 00002158 BL GETIDRTN NO, JUST RETURN 00002159 MVC NODEID(8),RDRESP+12 COPY NODEID FROM IDENITFY 00002160 GETIDRTN LM R14,R1,GETSAVE RESTORE REGISTERS 00002161 BR R14 RETURN 00002162 SPACE 00002163 GETSAVE DS 2D SAVE AREA: R14, R15, R0, R1 00002164 IDPLIST DS 0D 00002165 DC CL8'IDENTIFY' IDENTIFY COMMAND 00002166 DC CL8'(' 00002167 DC CL8'LIFO' 00002168 DC 8X'FF' 00002169 EJECT 00002170 * 00002171 * WMAC DATA AREA: 00002172 * 00002173 SPACE 00002174 FSTCOPY DS 8D COPY OF FST 00002175 DECBUF DS 2D BUFFER FOR CONVERSIONS 00002176 STRTTIME DS 1D START TIME FOR RATE CALC. 00002177 ENDTIME DS 1D END TIME FOR RATE CALC. 00002178 TOTSECS DS 1D TOTAL ELAPSED TIME 00002179 WCCW DS 0D 3270 WRITE CCW 00002180 DC X'29' OP-CODE 00002181 DC AL3(GRAFDATA) BUFFER ADDRESS 00002182 DC X'20' CCW FLAG BITS 00002183 DC X'80' CONTROL BITS FOR CP 00002184 WCCWLEN DC AL2(*-*) LENGTH 00002185 WSFCCW1 DS 0D 3270 WSF CCW 00002186 DC X'29' OP-CODE 00002187 DC AL3(WSFQRCMD) BUFFER ADDRESS 00002188 DC X'20' CCW FLAG BITS 00002189 DC X'20' CONTROL BITS FOR CP 00002190 DC AL2(5) LENGTH 00002191 WSFCCW2 DS 0D 3270 WSF CCW 00002192 DC X'29' OP-CODE 00002193 DC AL3(WSFRPQ) BUFFER ADDRESS 00002194 DC X'20' CCW FLAG BITS 00002195 DC X'20' CONTROL BITS FOR CP 00002196 DC AL2(7) LENGTH 00002197 WSFCCW3 DS 0D 3270 WSF CCW 00002198 DC X'29' OP-CODE 00002199 DC AL3(GRAFDATA) BUFFER ADDRESS 00002200 DC X'20' CCW FLAG BITS 00002201 DC X'20' CONTROL BITS FOR CP 00002202 WSFCCWLN DC AL2(*-*) LENGTH 00002203 RCCW DS 0D 3270 READ CCW 00002204 DC X'2A' OP-CODE 00002205 DC AL3(GRAFDATA) BUFFER ADDRESS 00002206 DC X'20' CCW FLAG BITS 00002207 DC X'80' CONTROL BITS FOR CP 00002208 DC AL2(4096) LENGTH 00002209 NODEID DS 1D MY NODEID 00002210 BROWNID DC CL8'BROWNVM' NODE ID AT BROWN 00002211 BUFSIZE DS 1F NO. OF BYTES IN INPBUF 00002212 PCKSIZE DS 1F PACKET SIZE 00002213 RETRYCNT DS 1F RETRY COUNT FOR ALL BLOCKS 00002214 BLOCKNO DS 1F CP/M BLOCK NUMBER 00002215 WRCNT DS 1F BYTES WRITTEN FOR RATE CALC. 00002216 RDCNT DS 1F BYTES READ FOR RATE CALC. 00002217 TOTCHRS DS 1F TOTAL CHARACTERS FOR RATE CALC. 00002218 INTAB DS 1A SAVED USER INPUT TABLE 00002219 OUTTAB DS 1A SAVED USER OUTPUT TABLE 00002220 INPBUFDW DS 1F (1) DOUBLEWORDS FOR INPBUF 00002221 INPBUF DS 1A (2) BUFFER FOR CMS FILE DATA 00002222 EJECT 00002223 OPTTAB DS 0F OPTION PROCESSING TABLE 00002224 DC CL8'ASCII',AL4(ASCOPT) 00002225 DC CL8'BINARY',AL4(BINOPT) 00002226 DC CL8'MACBIN',AL4(MACOPT) 00002227 DC CL8'MENU',AL4(MENUOPT) 00002228 DC CL8'NOASCII',AL4(NOASCOPT) 00002229 DC CL8'NOBINARY',AL4(NOBINOPT) 00002230 DC CL8'NOMACBIN',AL4(NOMACOPT) 00002231 DC CL8'NOMENU',AL4(NOMENOPT) 00002232 DC CL8'NOPRINT',AL4(NOPRTOPT) 00002233 DC CL8'PRINT',AL4(PRTOPT) 00002234 DC CL8'STDXLATE',AL4(STDXOPT) 00002235 DC CL8'TEXT',AL4(TEXTOPT) 00002236 DC CL8'TRUNCATE',AL4(TRUNCOPT) 00002237 DC 8X'FF',AL4(-1) 00002238 INFILE FSCB FORM=E INPUT FILE CONTROL BLOCK 00002239 MACID DC CL17' ' MAC FILE ID 00002240 DELIM DC C' ' DEFAULT DELIMITER 00002241 SENDLEN DS 1H BYTE COUNT FOR SEND BUFFER 00002242 RECVLEN DS 1H BYTE COUNT FOR RECEIVE BUFFER 00002243 GRAFLEN DS 1H BYTE COUNT FOR 3270 BUFFER 00002244 CONADDR DS 1H 3270 CONSOLE ADDRESS 00002245 WSFQRCMD DC X'000501FF02' WSF QUERY REPLY COMMAND 00002246 WSFRPQ DC X'000701FF0300A1' WSF QUERY LIST FOR RPQ NAMES 00002247 CTLFS DC X'2E2E' CTL-F (ACK) START XFER CODES 00002248 ABORTSTR DC X'02022F' START BYTES AND CTL-G 00002249 ABRTSTRC DC X'02022D' 00002250 RETRYMSG DC C'Retransmitting command',X'15' 00002251 DC X'2D' BELL AT END OF MESSAGE 00002252 RMSGL EQU *-RETRYMSG MESSAGE LENGTH 00002253 DSKMODE DC CL2' ' DISK MODE FOR ERROR MESSAGE 00002254 PRMTCMD DC AL1(PRMTCMDL) CP PROMPT COMMAND FOR LINEDIT 00002255 DC C'TERM PROMPT >',X'12' 00002256 PRMTCMDL EQU *-PRMTCMD-1 00002257 VERSDATA DS 5C VERSION DATA 00002258 M3270VER DS 5C MAC3270 VERSION DATA (FROM WSF) 00002259 XFSPEED DS 4C TRANSFER SPEED, CPS 00002260 RDRESP DC CL130' ' RDTERM RESPONSE BUFFER 00002261 FLAGS DS 1X FLAG BYTE 00002262 FINIS EQU X'01' CALL FINIS FOR INPUT FILE 00002263 RDREC EQU X'02' DATA HAS BEEN READ 00002264 XFS EQU X'04' XFSPEED IS SUPPORTED 00002265 NOMENU EQU X'08' HAVE MAC SKIP FILE MENU 00002266 TEXT EQU X'10' TEXT OPTION SPECIFIED 00002267 BLNKLINE EQU X'20' LAST LINE WAS BLANK 00002268 FS3270 EQU X'40' 3270 IN FULL SCREEN MODE 00002269 TRUNCATE EQU X'80' TRUNCATE OPTION SPECIFIED 00002270 FLAGS2 DS 1X SECOND FLAG BYTE 00002271 BINXF EQU X'01' BINARY TRANSFER 00002272 TERMINIT EQU X'02' TERMINAL INIT. DONE 00002273 ASCBIN EQU X'04' ASCII<-->BINARY SUPPORTED 00002274 COMP EQU X'08' DATA COMPRESSION SUPPORTED 00002275 ASCXF EQU X'10' ASCII TRANSFER FORCED 00002276 IOBUFF EQU X'20' INPBUF ALLOCATED 00002277 MACBIN EQU X'40' MACBINARY TRANSFER 00002278 PRTXF EQU X'80' DOWNLOAD TO PRINTER 00002279 FLAGS3 DS 1X THIRD FLAG BYTE 00002280 ALTTR EQU X'01' USE ALT. (LOCAL) XLATE TABLES 00002281 TRMFLAGS DS 1X FLAG BYTE FOR TERMINAL STATUS 00002282 SFDEV EQU X'01' WSF MAY BE SUPPORTED 00002283 GRAFTRM EQU X'02' 3270 TERMINAL 00002284 MAC3270 EQU X'04' MAC3270 IN USE 00002285 VTAM EQU X'08' VTAM CONNECTION 00002286 LTORG 00002287 SENDSTRT DC 2X'02' HEADER: 2 START BYTES 00002288 SENDDATA DS CL2328 SEND DATA BUFFER 00002289 RECVDATA DS CL128 RECEIVE DATA BUFFER 00002290 GRAFDATA DS 512D 3270 I/O BUFFER 00002291 ABINDATA DS 130D ASCBIN BUFFER 00002292 EJECT 00002293 TOASCBRN DS 0D BROWN'S CP EBCDIC TO ASCII TRANSLATE TABLE 00002294 DC X'000102037F097F7F7F7F7F0B0C0D0E0F' *....".""""".....* 00002295 DC X'101112137F0A087F18197F7F1C1D1E1F' *....".."..""....* 00002296 DC X'7F7F1C7F7F0A171B7F7F7F7F7F050607' *"".""..."""""...* 00002297 DC X'7F7F167F7F1E7F047F7F7F1314157F1A' *"".""."."""...".* 00002298 DC X'207F7F7F7F7F7F7F7F7F5B2E3C282B5E' *."""""""""$....;* 00002299 DC X'267F7F7F7F7F7F7F7F7F21242A293B7E' *.""""""""".....=* 00002300 DC X'2D2F7F7F7F7F7F7F7F7F7C2C255F3E3F' *..""""""""@..^..* 00002301 DC X'7F7F7F7F7F7F7F7F607F3A2340273D22' *""""""""-".. ...* 00002302 DC X'7F6162636465666768697F7B7F7F7F7F' *"/........"#""""* 00002303 DC X'7F6A6B6C6D6E6F7071727F7D7F7F7F7F' *".,%_>?..."'""""* 00002304 DC X'7F7F737475767778797A7F7F7F5B7F7F' *"".......:"""$""* 00002305 DC X'7F7F7F7F7F7F7F7F7F7F7F7F7F5D7F7F' *""""""""""""")""* 00002306 DC X'7F4142434445464748497F7F7F7F7F7F' *".........""""""* 00002307 DC X'7F4A4B4C4D4E4F5051527F7F7F7F7F7F' *"..<(+|&..""""""* 00002308 DC X'5C7F535455565758595A7F7F7F7F7F7F' **".......!""""""* 00002309 DC X'303132333435363738397F7F7F7F7F7F' *..........""""""* 00002310 SPACE 00002311 FRASCBRN DS 0D BROWN'S CP ASCII TO EBCDIC TRANSLATE TABLE 00002312 DC X'00010203372D2E2F1605250B0C0D0E0F' 00002313 DC X'FF11123B3C3D322618193F271C1D1E1F' 00002314 DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' 00002315 DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' 00002316 DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' 00002317 DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD4F6D' 00002318 DC X'78818283848586878889919293949596' 00002319 DC X'979899A2A3A4A5A6A7A8A98B6A9B5F07' 00002320 DC X'00010203372D2E2F1605250B0C0D0E0F' 00002321 DC X'FF11123B3C3D322618193F271C1D1E1F' 00002322 DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' 00002323 DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' 00002324 DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' 00002325 DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD4F6D' 00002326 DC X'78818283848586878889919293949596' 00002327 DC X'979899A2A3A4A5A6A7A8A98B6A9B5F07' 00002328 EJECT 00002329 TRTABBRN DC 256AL1(*-TRTABBRN) BROWN INVALID CHARACTER TABLE 00002330 ORG TRTABBRN 00002331 DC 64C'║' 00002332 ORG TRTABBRN+X'05' ALLOW TAB 00002333 DC X'05' 00002334 ORG TRTABBRN+X'0C' ALLOW FORM FEED 00002335 DC X'0C' 00002336 ORG TRTABBRN+X'41' 00002337 DC 10C'║' 00002338 ORG TRTABBRN+X'51' 00002339 DC 9C'║' 00002340 ORG TRTABBRN+X'62' 00002341 DC 8C'║' 00002342 ORG TRTABBRN+X'70' 00002343 DC 8C'║',X'78',C'║' 00002344 ORG TRTABBRN+X'80' 00002345 DC C'║' 00002346 ORG TRTABBRN+X'8A' 00002347 DC C'║' 00002348 ORG TRTABBRN+X'8C' 00002349 DC 5C'║' 00002350 ORG TRTABBRN+X'9A' 00002351 DC C'║' 00002352 ORG TRTABBRN+X'9C' 00002353 DC 6C'║' 00002354 ORG TRTABBRN+X'AA' 00002355 DC 3C'║' 00002356 ORG TRTABBRN+X'AE' 00002357 DC 15C'║' 00002358 ORG TRTABBRN+X'BE' 00002359 DC 3C'║' 00002360 ORG TRTABBRN+X'CA' 00002361 DC 7C'║' 00002362 ORG TRTABBRN+X'DA' 00002363 DC 6C'║' 00002364 ORG TRTABBRN+X'E1' 00002365 DC C'║' 00002366 ORG TRTABBRN+X'EA' 00002367 DC 6C'║' 00002368 ORG TRTABBRN+X'FA' 00002369 DC 6C'║' 00002370 ORG 00002371 EJECT 00002372 TOASCSTD DS 0D STANDARD CP EBCDIC TO ASCII TABLE 00002373 DC X'000102037F097F7F7F7F7F0B0C0D0E0F' *....".""""".....* 00002374 DC X'101112137F0A080018197F7F1C1D1E1F' *....".....""....* 00002375 DC X'7F7F7F7F7F0A171B7F7F7F7F7F050607' *"""""..."""""...* 00002376 DC X'7F7F167F7F7F7F047F7F7F7F14157F1A' *""."""".""""..".* 00002377 DC X'207F7F7F7F7F7F7F7F7F7F2E3C282B7C' *.""""""""""....@* 00002378 DC X'267F7F7F7F7F7F7F7F7F21242A293B5E' *.""""""""".....;* 00002379 DC X'2D2F7F7F7F7F7F7F7F7F7C2C255F3E3F' *..""""""""@..^..* 00002380 DC X'7F7F7F7F7F7F7F7F7F603A2340273D22' *"""""""""-.....* 00002381 DC X'7F6162636465666768697F7F7F7F7F7F' *"/........""""""* 00002382 DC X'7F6A6B6C6D6E6F7071727F7F7F7F7F7F' *".,%_>?...""""""* 00002383 DC X'7F7E737475767778797A7F7F7F5B7F7F' *"=.......:"""$""* 00002384 DC X'7F7F7F7F7F7F7F7F7F7F7F7F7F5D7F7F' *""""""""""""")""* 00002385 DC X'7B4142434445464748497F7F7F7F7F7F' *#.........""""""* 00002386 DC X'7D4A4B4C4D4E4F5051527F7F7F7F7F7F' *'║.<(+|&..""""""* 00002387 DC X'5C7F535455565758595A7F7F7F7F7F7F' **".......!""""""* 00002388 DC X'303132333435363738397F7F7F7F7F7F' *..........""""""* 00002389 SPACE 00002390 FRASCSTD DS 0D STANDARD CP ASCII TO EBCDIC TABLE 00002391 DC X'00010203372D2E2F1605250B0C0D0E0F' 00002392 DC X'101112133C3D322618193F271C1D1E1F' 00002393 DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' 00002394 DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' 00002395 DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' 00002396 DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D' 00002397 DC X'79818283848586878889919293949596' 00002398 DC X'979899A2A3A4A5A6A7A8A9C04FD0A107' 00002399 DC X'00010203372D2E2F1605250B0C0D0E0F' 00002400 DC X'101112133C3D322618193F271C1D1E1F' 00002401 DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' 00002402 DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' 00002403 DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' 00002404 DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D' 00002405 DC X'79818283848586878889919293949596' 00002406 DC X'979899A2A3A4A5A6A7A8A9C04FD0A107' 00002407 EJECT 00002408 TRTABSTD DC 256AL1(*-TRTABSTD) STANDARD INVALID CHARACTER TABL 00002409 ORG TRTABSTD 00002410 DC 64C'║' 00002411 ORG TRTABSTD+X'05' ALLOW TAB 00002412 DC X'05' 00002413 ORG TRTABSTD+X'0C' ALLOW FORM FEED 00002414 DC X'0C' 00002415 ORG TRTABSTD+X'41' 00002416 DC 10C'║' 00002417 ORG TRTABSTD+X'51' 00002418 DC 9C'║' 00002419 ORG TRTABSTD+X'62' 00002420 DC 8C'║' 00002421 ORG TRTABSTD+X'70' 00002422 DC 9C'║' 00002423 ORG TRTABSTD+X'80' 00002424 DC C'║' 00002425 ORG TRTABSTD+X'8A' 00002426 DC 7C'║' 00002427 ORG TRTABSTD+X'9A' 00002428 DC 7C'║' 00002429 ORG TRTABSTD+X'AA' 00002430 DC 3C'║' 00002431 ORG TRTABSTD+X'AE' 00002432 DC 15C'║' 00002433 ORG TRTABSTD+X'BE' 00002434 DC 2C'║' 00002435 ORG TRTABSTD+X'CA' 00002436 DC 6C'║' 00002437 ORG TRTABSTD+X'DA' 00002438 DC 6C'║' 00002439 ORG TRTABSTD+X'E1' 00002440 DC C'║' 00002441 ORG TRTABSTD+X'EA' 00002442 DC 6C'║' 00002443 ORG TRTABSTD+X'FA' 00002444 DC 6C'║' 00002445 ORG 00002446 SPACE 2 00002447 TOLOWER DC 256AL1(*-TOLOWER) UPPER -> LOWERCASE XTAB 00002448 ORG TOLOWER+C'^' "^" -> BLANK 00002449 DC C' ' 00002450 ORG TOLOWER+C'A' 00002451 DC C'abcdefghi' 00002452 ORG TOLOWER+C'J' 00002453 DC C'jklmnopqr' 00002454 ORG TOLOWER+C'S' 00002455 DC C'stuvwxyz' 00002456 ORG 00002457 EJECT 00002458 ABINTAB DC 256X'00' TABLE FOR BINARY QUOTING 00002459 ORG ABINTAB+X'00' 00002460 DC X'03' NULL -> X'03' 00002461 DC 8X'15' X'01' - X'08' QUOTED 00002462 DC X'00' TAB SENT AS IS 00002463 DC X'0B' LF -> X'0B' 00002464 DC X'15' X'0B' QUOTED 00002465 DC X'00' FF SENT AS IS 00002466 DC X'0E' CR -> X'OE' 00002467 DC 10X'15' X'0E' - X'17' QUOTED 00002468 DC X'00' X'18' SENT AS IS 00002469 DC 7X'15' X'19' - X'1F' QUOTED 00002470 ORG ABINTAB+X'7F' 00002471 DC 49X'15' X'7F' - X'AF' QUOTED 00002472 DC 80X'16' X'B0' - X'FF' QUOTED 00002473 ORG 00002474 HBITTAB DC 128AL1(*-HBITTAB+128) TABLE TO TURN ON HIGH-ORDER 00002475 DC 128AL1(*-HBITTAB) BIT FOR 7171 00002476 FSCBD 00002477 FSTD 00002478 NUCON 00002479 END 00002480